requires Qmail::Deliverable, which is a modern replacement for the apparently popular but no longer available check_deliver plugin. --- STATUS | 5 - plugins/check_qmail_deliverable | 202 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 202 insertions(+), 5 deletions(-) create mode 100755 plugins/check_qmail_deliverable
diff --git a/STATUS b/STATUS index 81cf0df..78ef005 100644 --- a/STATUS +++ b/STATUS @@ -18,11 +18,6 @@ Roadmap - Add user configuration plugin infrastructure - Add plugin API for checking if a local email address is valid - - - Include the popular check_delivery[1] functionality via the user API - [1] until then get it from - http://www.openminddev.net/files/qpsmtpd/plugins/check_delivery/ - - Add API to reject individual recipients after the RCPT has been accepted and generate individual bounce messages. diff --git a/plugins/check_qmail_deliverable b/plugins/check_qmail_deliverable new file mode 100755 index 0000000..6230e66 --- /dev/null +++ b/plugins/check_qmail_deliverable @@ -0,0 +1,202 @@ +#!/usr/bin/perl + +=head1 NAME + +check_qmail_deliverable - Check that the recipient address is deliverable + +=head1 DESCRIPTION + +See the description of Qmail::Deliverable. + +This B<qpsmtpd plugin> uses the client/server interface and needs a running +qmail-deliverabled. If no connection can be made, deliverability is simply +assumed. + +The modules LWP (libwww-perl) and HTTP::Daemon, available from CPAN, are +required for qmail-deliverabled and Qmail::Deliverable::Client. + +=head1 CONFIGURATION + +=over 4 + +=item server host:port + +Hostname (or IP address), and port (both!) of the qmail-deliverabled server. If +none is specified, the default (127.0.0.1:8998) is used. + +=item server smtproutes:host:port + +If the specification is prepended by the literal text C<smtproutes:>, then for +recipient domains listed in your /var/qmail/control/smtproutes use their +respective hosts for the check. For other domains, the given host is used. The +port has to be the same across all servers. + +Example: + + check_qmail_deliverable server smtproutes:127.0.0.1:8998 + +Use "smtproutes:8998" (no second colon) to simply skip the deliverability +check for domains not listed in smtproutes. + +=back + +=head1 CAVEATS + +Given a null host in smtproutes, the normal MX lookup should be used. This +plugin does not do this, because we don't want to harrass arbitrary servers. + +Connection failure is *faked* when there is no smtproute. + +=head1 LEGAL + +This software is released into the public domain, and does not come with +warranty or guarantee of any kind. Use it at your own risk. + +=head1 AUTHOR + +Juerd <#####@juerd.nl> + +=head1 SEE ALSO + +L<Qmail::Deliverable>, L<qmail-deliverabled>, L<Qmail::Deliverable::Client> + +=cut + +################################# +################################# + +BEGIN { + use FindBin qw($Bin $Script); + if (not $INC{'Qpsmtpd.pm'}) { + my $dir = '$PLUGINS_DIRECTORY'; + -d and $dir = $_ for qw( + /home/qpsmtpd/plugins + /home/smtp/qpsmtpd/plugins + /usr/local/qpsmtpd/plugins + /usr/local/share/qpsmtpd/plugins + /usr/share/qpsmtpd/plugins + ); + + my $file = "the 'plugins' configuration file"; + -f and $file = $_ for qw( + /home/qpsmtpd/config/plugins + /home/smtp/qpsmtpd/config/plugins + /usr/local/qpsmtpd/config/plugins + /usr/local/etc/qpsmtpd/plugins + /etc/qpsmtpd/plugins + ); + + # "die" would print "BEGIN failed" garbage + print STDERR <<"END"; + +This is a plugin for qpsmtpd and should not be run manually. + +To install the plugin: + + ln -s $Bin/$Script $dir/ + +And add "$Script server 127.0.0.1:8998" to $file, before rcpt_ok. +For configuration instructions, read "man $Script" + +(Paths may vary.) + +END + exit 255; + } +} + +################################# +################################# + +use Qmail::Deliverable::Client qw(deliverable); +use strict; + +my %smtproutes; +my $shared_domain; # global variable to be closed over by the SERVER callback + +sub register { + my ($self, $qp, @args) = @_; + if (@args % 2) { + $self->log(LOGWARN, "Odd number of arguments, using default config"); + } else { + my %args = @args; + if ($args{server} =~ /^smtproutes:/) { + + my ($fallback, $port) = $args{server} =~ /:(?:(.*?):?)(\d+)/; + + open my $fh, "/var/qmail/control/smtproutes" + or warn "Could not read smtproutes"; + for (readline $fh) { + my ($domain, $mx) = /^(.*?) : \[? ( [^\]:\s]* )/x; + $smtproutes{$domain} = $mx; + } + + $Qmail::Deliverable::Client::SERVER = sub { + my $server = _smtproute($shared_domain); + return "$server:$port" if defined $server; + return "$fallback:$port" if defined $fallback; + return; + }; + + } elsif ($args{server}) { + $Qmail::Deliverable::Client::SERVER = $args{server}; + } + } + $self->register_hook("rcpt", "rcpt_handler"); +} + +sub rcpt_handler { + my ($self, $transaction, $rcpt) = @_; + + my $address = $rcpt->address; + $self->log(LOGINFO, "Checking deliverability for recipient '$address'"); + + $shared_domain = $rcpt->host; + + my $rv = deliverable $address; + + if (not defined $rv or not length $rv) { + $self->log(LOGWARN, "Unknown error."); + return DECLINED; + } + + my $k = 0; # known status code + $self->log(LOGINFO, "Permission failure"), $k++ if $rv == 0x11; + $self->log(LOGINFO, "qmail-command in dot-qmail"), $k++ if $rv == 0x12; + $self->log(LOGINFO, "bouncesaying with program"), $k++ if $rv == 0x13; + $self->log(LOGINFO, "Temporarily undeliverable: group/world writable"), $k++ + if $rv == 0x21; + $self->log(LOGINFO, "Temporarily undeliverable: sticky home directory"),$k++ + if $rv == 0x22; + $self->log(LOGINFO, "Error: $Qmail::Deliverable::Client::ERROR"), $k++ + if $rv == 0x2f; + $self->log(LOGINFO, "Normal delivery"), $k++ if $rv == 0xf1; + $self->log(LOGINFO, "Deliverable through vpopmail"), $k++ if $rv == 0xf2; + $self->log(LOGINFO, "SHOULD NOT HAPPEN"), $k++ if $rv == 0xfe; + $self->log(LOGINFO, "Address is not local"), $k++ if $rv == 0xff; + + $self->log(LOGINFO, sprintf("Unknown: 0x%02x", $rv)) if $rv and not $k; + + return DECLINED if $rv; + return DENY, "Sorry, no mailbox here by that name. qd (#5.1.1)"; +} + +sub _smtproute { + my ($domain) = @_; + my @parts = split /\./, $domain; + if (exists $smtproutes{$domain}) { + return undef if $smtproutes{$domain} eq ""; + return $smtproutes{$domain}; + } + for (reverse 1 .. @parts) { + my $wildcard = join "", map ".$_", @parts[-$_ .. -1]; + if (exists $smtproutes{$wildcard}) { + return undef if $smtproutes{$wildcard} eq ""; + return $smtproutes{$wildcard}; + } + } + return undef if not exists $smtproutes{""}; + return undef if $smtproutes{""} eq ""; + return $smtproutes{""}; +} + -- 1.7.9.4
