167 lines
4.7 KiB
Perl
167 lines
4.7 KiB
Perl
#!perl -w
|
|
|
|
=head1 NAME
|
|
|
|
dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The dns_whitelist_soft plugin allows selected host to be whitelisted as
|
|
exceptions to later plugin processing. It is strongly based on the original
|
|
dnsbl plugin as well as Gavin Carr's original whitelist_soft plugin. It is
|
|
most suitable for multisite installations, so that the whitelist is stored
|
|
in one location and available from all.
|
|
|
|
=head1 CONFIGURATION
|
|
|
|
To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual.
|
|
It should precede any plugins whose rejections you wish to override. You may
|
|
have to alter those plugins to check the appropriate notes field.
|
|
|
|
Several configuration files are supported, corresponding to different
|
|
parts of the SMTP conversation:
|
|
|
|
=over 4
|
|
|
|
=item whitelist_zones
|
|
|
|
Any IP address listed in the whitelist_zones file is queried using
|
|
the connecting MTA's IP address. Any A or TXT answer means that the
|
|
remote HOST address can be selectively exempted at other stages by plugins
|
|
testing for a 'whitelisthost' connection note.
|
|
|
|
=back
|
|
|
|
NOTE: other 'connect' hooks will continue to fire (e.g. dnsbl), since the DNS
|
|
queries happen in the background. This plugin's 'rcpt_handler' retrieves
|
|
the results of the query and sets the connection note if found.
|
|
|
|
=head1 AUTHOR
|
|
|
|
John Peacock <jpeacock@rowman.com>
|
|
|
|
Based on the 'whitelist_soft' plugin by Gavin Carr <gavin@openfusion.com.au>,
|
|
based on the 'whitelist' plugin by Devin Carraway <qpsmtpd@devin.com>.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Qpsmtpd::Constants;
|
|
|
|
sub register {
|
|
my ($self, $qp) = (shift, shift);
|
|
$self->log(LOGERROR, "Bad arguments") if @_ % 2;
|
|
$self->{_args} = {@_};
|
|
}
|
|
|
|
sub hook_connect {
|
|
my ($self, $transaction) = @_;
|
|
|
|
my $remote_ip = $self->qp->connection->remote_ip;
|
|
|
|
my %whitelist_zones =
|
|
map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('whitelist_zones');
|
|
|
|
return DECLINED unless %whitelist_zones;
|
|
|
|
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
|
|
|
|
# queue lookups in the background and fetch the
|
|
# results in the first rcpt handler
|
|
|
|
my $res = $self->get_resolver();
|
|
my $sel = IO::Select->new();
|
|
|
|
for my $dnsbl (keys %whitelist_zones) {
|
|
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background");
|
|
$sel->add($res->bgsend("$reversed_ip.$dnsbl", 'TXT'));
|
|
}
|
|
|
|
$self->connection->notes('whitelist_sockets', $sel);
|
|
return DECLINED;
|
|
}
|
|
|
|
sub process_sockets {
|
|
my ($self) = @_;
|
|
|
|
my $conn = $self->connection;
|
|
|
|
return $conn->notes('whitelisthost') if $conn->notes('whitelisthost');
|
|
|
|
my $res = $self->get_resolver();
|
|
my $sel = $conn->notes('whitelist_sockets') or return '';
|
|
|
|
$self->log(LOGDEBUG, "waiting for whitelist dns");
|
|
|
|
# don't wait more than 4 seconds here
|
|
my @ready = $sel->can_read(4);
|
|
|
|
$self->log(LOGDEBUG,
|
|
"done waiting for whitelist dns, got ",
|
|
scalar @ready,
|
|
" answers ...");
|
|
return '' unless @ready;
|
|
|
|
my $result;
|
|
|
|
for my $socket (@ready) {
|
|
my $query = $res->bgread($socket);
|
|
$sel->remove($socket);
|
|
undef $socket;
|
|
|
|
my $whitelist;
|
|
|
|
if ($query) {
|
|
my $a_record = 0;
|
|
foreach my $rr ($query->answer) {
|
|
$a_record = 1 if $rr->type eq 'A';
|
|
my $name = $rr->name;
|
|
($whitelist) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $whitelist;
|
|
$whitelist = $name unless $whitelist;
|
|
$self->log(LOGDEBUG, 'name ', $rr->name);
|
|
next unless $rr->type eq 'TXT';
|
|
$self->log(LOGDEBUG, "got txt record");
|
|
$result = $rr->txtdata and last;
|
|
}
|
|
$a_record and $result = "Blocked by $whitelist";
|
|
}
|
|
else {
|
|
$self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring)
|
|
if $res->errorstring ne "NXDOMAIN";
|
|
}
|
|
|
|
if ($result) {
|
|
|
|
# kill any other pending I/O
|
|
$conn->notes('whitelist_sockets', undef);
|
|
return $conn->notes('whitelisthost', $result);
|
|
}
|
|
}
|
|
|
|
if ($sel->count) {
|
|
|
|
# loop around if we have dns blacklists left to see results from
|
|
return $self->process_sockets();
|
|
}
|
|
|
|
# er, the following code doesn't make much sense anymore...
|
|
|
|
# if there was more to read; then forget it
|
|
$conn->notes('whitelist_sockets', undef);
|
|
|
|
return $conn->notes('whitelisthost', $result);
|
|
}
|
|
|
|
sub hook_rcpt {
|
|
my ($self, $transaction, $rcpt, %param) = @_;
|
|
my $ip = $self->qp->connection->remote_ip or return DECLINED;
|
|
my $note = $self->process_sockets;
|
|
if ($note) {
|
|
$self->log(LOGNOTICE, "Host $ip is whitelisted: $note");
|
|
}
|
|
return DECLINED;
|
|
}
|
|
|