[PATCH] imported check_qmail_deliverable

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