225 lines
6.9 KiB
Perl
Executable File
225 lines
6.9 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
=head1 NAME
|
|
|
|
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:
|
|
|
|
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.
|
|
|
|
=item vpopmail_ext [ 0 | 1 ]
|
|
|
|
Is vpopmail configured with the qmail-ext feature enabled? If so, this config
|
|
option must be enabled in order for user-ext@example.org addresses to work.
|
|
|
|
Default: 0
|
|
|
|
=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 strict;
|
|
use warnings;
|
|
|
|
use Qpsmtpd::Constants;
|
|
use Qmail::Deliverable::Client qw(deliverable);
|
|
|
|
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} && $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};
|
|
}
|
|
|
|
if ( $args{vpopmail_ext} ) {
|
|
$Qmail::Deliverable::VPOPMAIL_EXT = $args{vpopmail_ext};
|
|
};
|
|
}
|
|
$self->register_hook("rcpt", "rcpt_handler");
|
|
}
|
|
|
|
sub rcpt_handler {
|
|
my ($self, $transaction, $rcpt) = @_;
|
|
|
|
return DECLINED if $self->is_immune(); # requires QP 0.90+
|
|
|
|
my $address = $rcpt->address;
|
|
$self->log(LOGDEBUG, "Checking deliverability for recipient '$address'");
|
|
|
|
$shared_domain = $rcpt->host;
|
|
|
|
my $rv = deliverable $address;
|
|
|
|
if (not defined $rv or not length $rv) {
|
|
$self->log(LOGWARN, "error (unknown) checking '$address'");
|
|
return DECLINED;
|
|
}
|
|
|
|
my $k = 0; # known status code
|
|
$self->log(LOGINFO, "error, permission failure"), $k++ if $rv == 0x11;
|
|
$self->log(LOGINFO, "pass, qmail-command in dot-qmail"),$k++ if $rv == 0x12;
|
|
$self->log(LOGINFO, "pass, 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, "pass, normal delivery"), $k++ if $rv == 0xf1;
|
|
$self->log(LOGINFO, "pass, vpopmail dir"), $k++ if $rv == 0xf2;
|
|
$self->log(LOGINFO, "pass, vpopmail alias"), $k++ if $rv == 0xf3;
|
|
$self->log(LOGINFO, "pass, vpopmail catchall"), $k++ if $rv == 0xf4;
|
|
$self->log(LOGINFO, "pass, vpopmail vuser"), $k++ if $rv == 0xf5;
|
|
$self->log(LOGINFO, "pass, vpopmail qmail-ext"), $k++ if $rv == 0xf6;
|
|
$self->log(LOGINFO, "error, SHOULD NOT HAPPEN"), $k++ if $rv == 0xfe;
|
|
$self->log(LOGINFO, "fail, address not local"), $k++ if $rv == 0xff;
|
|
|
|
if ( $rv ) {
|
|
$self->log(LOGINFO, sprintf("error, unknown: 0x%02x", $rv)) if not $k;
|
|
return DECLINED;
|
|
};
|
|
|
|
return (DENY, "Sorry, no mailbox 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{""};
|
|
}
|
|
|