refactored dnsbl, sprinkling logs and tests on it

This commit is contained in:
Matt Simerson 2012-05-05 03:03:40 -04:00 committed by Robert
parent a6e664ce83
commit a1b073cfe2
2 changed files with 149 additions and 79 deletions

View File

@ -13,43 +13,32 @@ a configurable set of RBL services.
sub register { sub register {
my ($self, $qp, $denial ) = @_; my ($self, $qp, $denial ) = @_;
if ( defined $denial and $denial =~ /^disconnect$/i ) { if ( defined $denial && $denial =~ /^disconnect$/i ) {
$self->{_dnsbl}->{DENY} = DENY_DISCONNECT; $self->{_dnsbl}->{DENY} = DENY_DISCONNECT;
} }
else { else {
$self->{_dnsbl}->{DENY} = DENY; $self->{_dnsbl}->{DENY} = DENY;
} }
} }
sub hook_connect { sub hook_connect {
my ($self, $transaction) = @_; my ($self, $transaction) = @_;
my $remote_ip = $self->qp->connection->remote_ip; # perform RBLSMTPD checks to mimic Dan Bernstein's rblsmtpd
return DECLINED if $self->is_set_rblsmtpd();
# perform RBLSMTPD checks to mimic Dan Bernstein's rblsmtpd return DECLINED if $self->ip_whitelisted();
if (defined($ENV{'RBLSMTPD'})) {
if ($ENV{'RBLSMTPD'} ne '') {
$self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip");
return DECLINED;
} else {
$self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip");
return DECLINED;
}
} else {
$self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip");
}
my $allow = grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->qp->config('dnsbl_allow');
return DECLINED if $allow;
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones'); my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
return DECLINED unless %dnsbl_zones; if ( ! %dnsbl_zones ) {
$self->log( LOGDEBUG, "skip: no list configured");
return DECLINED;
};
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip))); my $remote_ip = $self->qp->connection->remote_ip;
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
# we should queue these lookups in the background and just fetch the # we queue these lookups in the background and fetch the
# results in the first rcpt handler ... oh well. # results in the first rcpt handler
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
$res->tcp_timeout(30); $res->tcp_timeout(30);
@ -64,7 +53,8 @@ sub hook_connect {
if (defined($dnsbl_zones{$dnsbl})) { if (defined($dnsbl_zones{$dnsbl})) {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl")); $sel->add($res->bgsend("$reversed_ip.$dnsbl"));
} else { }
else {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background"); $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT")); $sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
} }
@ -76,32 +66,70 @@ sub hook_connect {
return DECLINED; return DECLINED;
} }
sub is_set_rblsmtpd {
my $self = shift;
my $remote_ip = $self->qp->connection->remote_ip;
if ( ! defined $ENV{'RBLSMTPD'} ) {
$self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip");
return;
};
if ($ENV{'RBLSMTPD'} ne '') {
$self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip");
return $ENV{'RBLSMTPD'};
}
$self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip");
return 1; # don't return empty string, it evaluates to false
};
sub ip_whitelisted {
my ($self) = @_;
my $remote_ip = $self->qp->connection->remote_ip;
my $white = $self->qp->connection->notes('whitelisthost');
if ( $white ) {
$self->log(LOGDEBUG, "skip: whitelist overrode blacklist: $white");
return 1;
};
if ( $self->qp->connection->relay_client() ) {
$self->log(LOGWARN, "skip: don't blacklist relay/auth clients");
return 1;
};
return grep { s/\.?$/./;
$_ eq substr($remote_ip . '.', 0, length $_)
}
$self->qp->config('dnsbl_allow');
};
sub process_sockets { sub process_sockets {
my ($self) = @_; my ($self) = @_;
my $conn = $self->qp->connection; my $conn = $self->qp->connection;
return $conn->notes('dnsbl') return $conn->notes('dnsbl') if $conn->notes('dnsbl');
if $conn->notes('dnsbl');
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones'); my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
my $sel = $conn->notes('dnsbl_sockets') or return '';
my $dom = $conn->notes('dnsbl_domains');
my $remote_ip = $self->qp->connection->remote_ip;
my $result;
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
$res->tcp_timeout(30); $res->tcp_timeout(30);
$res->udp_timeout(30); $res->udp_timeout(30);
my $sel = $conn->notes('dnsbl_sockets') or return "";
my $dom = $conn->notes('dnsbl_domains');
my $remote_ip = $self->qp->connection->remote_ip;
my $result;
$self->log(LOGDEBUG, "waiting for dnsbl dns"); $self->log(LOGDEBUG, "waiting for dnsbl dns");
# don't wait more than 8 seconds here # don't wait more than 8 seconds here
my @ready = $sel->can_read(8); my @ready = $sel->can_read(8);
$self->log(LOGDEBUG, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ; $self->log(LOGDEBUG, "DONE waiting for dnsbl dns, got ", scalar @ready, " answers ...");
return '' unless @ready; return '' unless @ready;
for my $socket (@ready) { for my $socket (@ready) {
@ -114,16 +142,16 @@ sub process_sockets {
if ($query) { if ($query) {
my $a_record = 0; my $a_record = 0;
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
my $name = $rr->name; my $name = $rr->name;
$self->log(LOGDEBUG, "name $name"); $self->log(LOGDEBUG, "name $name");
next unless $dom->{$name}; next unless $dom->{$name};
$self->log(LOGDEBUG, "name $name was queried"); $self->log(LOGDEBUG, "name $name was queried");
$a_record = 1 if $rr->type eq "A"; $a_record = 1 if $rr->type eq "A";
($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl; ($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
$dnsbl = $name unless $dnsbl; $dnsbl = $name unless $dnsbl;
next unless $rr->type eq "TXT"; next unless $rr->type eq "TXT";
$self->log(LOGDEBUG, "got txt record"); $self->log(LOGDEBUG, "got txt record");
$result = $rr->txtdata and last; $result = $rr->txtdata and last;
} }
#$a_record and $result = "Blocked by $dnsbl"; #$a_record and $result = "Blocked by $dnsbl";
@ -132,7 +160,8 @@ sub process_sockets {
$result = $dnsbl_zones{$dnsbl}; $result = $dnsbl_zones{$dnsbl};
#$result =~ s/%IP%/$ENV{'TCPREMOTEIP'}/g; #$result =~ s/%IP%/$ENV{'TCPREMOTEIP'}/g;
$result =~ s/%IP%/$remote_ip/g; $result =~ s/%IP%/$remote_ip/g;
} else { }
else {
# shouldn't get here? # shouldn't get here?
$result = "Blocked by $dnsbl"; $result = "Blocked by $dnsbl";
} }
@ -140,7 +169,7 @@ sub process_sockets {
} }
else { else {
$self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring) $self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN"; unless $res->errorstring eq "NXDOMAIN";
} }
if ($result) { if ($result) {
@ -162,39 +191,31 @@ sub process_sockets {
$conn->notes('dnsbl_sockets', undef); $conn->notes('dnsbl_sockets', undef);
return $conn->notes('dnsbl', $result); return $conn->notes('dnsbl', $result);
} }
sub hook_rcpt { sub hook_rcpt {
my ($self, $transaction, $rcpt, %param) = @_; my ($self, $transaction, $rcpt, %param) = @_;
my $connection = $self->qp->connection;
# RBLSMTPD being non-empty means it contains the failure message to return # RBLSMTPD being non-empty means it contains the failure message to return
if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') { if (defined ($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') {
my $result = $ENV{'RBLSMTPD'}; my $result = $ENV{'RBLSMTPD'};
my $remote_ip = $connection->remote_ip; my $remote_ip = $self->qp->connection->remote_ip;
$result =~ s/%IP%/$remote_ip/g; $result =~ s/%IP%/$remote_ip/g;
return ($self->{_dnsbl}->{DENY}, my $msg = $self->qp->config('dnsbl_rejectmsg');
join(" ", $self->qp->config('dnsbl_rejectmsg'), $result)); $self->log(LOGINFO, $msg);
return ($self->{_dnsbl}->{DENY}, join(' ', $msg, $result));
} }
my $note = $self->process_sockets; my $note = $self->process_sockets or return DECLINED;
my $whitelist = $connection->notes('whitelisthost'); return DECLINED if $self->ip_whitelisted();
if ( $note ) {
if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) { if ( $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i ) {
$self->log(LOGWARN, "Don't blacklist special account: ".$rcpt->user); $self->log(LOGWARN, "skip: don't blacklist special account: ".$rcpt->user);
return DECLINED;
} }
elsif ( $whitelist ) {
$self->log(LOGWARN, "Whitelist overrode blacklist: $whitelist"); $self->log(LOGINFO, 'fail');
} return ($self->{_dnsbl}->{DENY}, $note);
elsif ( $connection->relay_client() ) {
$self->log(LOGWARN, "Don't blacklist relay/auth clients");
}
else {
return ($self->{_dnsbl}->{DENY}, $note);
}
}
return DECLINED;
} }
sub hook_disconnect { sub hook_disconnect {
@ -205,7 +226,6 @@ sub hook_disconnect {
return DECLINED; return DECLINED;
} }
=head1 Usage =head1 Usage
Add the following line to the config/plugins file: Add the following line to the config/plugins file:

View File

@ -1,27 +1,77 @@
#!perl -w
use strict;
use warnings;
use Qpsmtpd::Constants;
sub register_tests { sub register_tests {
my $self = shift; my $self = shift;
$self->register_test("test_local", 1);
$self->register_test("test_returnval", 1); $self->register_test('test_hook_connect', 2);
$self->register_test('test_hook_rcpt', 2);
$self->register_test('test_ip_whitelisted', 3);
$self->register_test('test_is_set_rblsmtpd', 4);
$self->register_test('test_hook_disconnect', 1);
} }
sub test_local { sub test_ip_whitelisted {
my $self = shift; my $self = shift;
$self->qp->connection->remote_ip('10.1.1.1');
$self->qp->connection->relay_client(1);
ok( $self->ip_whitelisted('10.1.1.1'), "ip_whitelisted, +");
$self->qp->connection->relay_client(0);
ok( ! $self->ip_whitelisted('10.1.1.1'), "ip_whitelisted, -");
$self->qp->connection->notes('whitelisthost', 'hello honey!');
ok( $self->ip_whitelisted('10.1.1.1'), "ip_whitelisted, +");
$self->qp->connection->notes('whitelisthost', undef);
};
sub test_is_set_rblsmtpd {
my $self = shift;
$self->qp->connection->remote_ip('10.1.1.1');
ok( ! defined $self->is_set_rblsmtpd('10.1.1.1'), "is_set_rblsmtpd, undef");
$ENV{RBLSMTPD} = "Yes we can!";
cmp_ok( 'Yes we can!','eq',$self->is_set_rblsmtpd('10.1.1.1'), "is_set_rblsmtpd, value");
$ENV{RBLSMTPD} = "Oh yeah?";
cmp_ok( 'Oh yeah?','eq',$self->is_set_rblsmtpd('10.1.1.1'), "is_set_rblsmtpd, value");
$ENV{RBLSMTPD} = '';
cmp_ok( 1,'==',$self->is_set_rblsmtpd('10.1.1.1'), "is_set_rblsmtpd, empty");
};
sub test_hook_connect {
my $self = shift;
my $connection = $self->qp->connection; my $connection = $self->qp->connection;
$connection->remote_ip('127.0.0.2'); # standard dnsbl test value $connection->remote_ip('127.0.0.2'); # standard dnsbl test value
$self->hook_connect($self->qp->transaction); cmp_ok( DECLINED, '==', $self->hook_connect($self->qp->transaction),
"hook_connect +");
ok($self->qp->connection->notes('dnsbl_sockets'));
ok($connection->notes('dnsbl_sockets'), "hook_connect, sockets");
ok($connection->notes('dnsbl_domains'), "hook_connect, domains");
} }
sub test_returnval { sub test_hook_rcpt {
my $self = shift; my $self = shift;
my $address = Qpsmtpd::Address->parse('<rcpt@example.com>'); my $address = Qpsmtpd::Address->parse('<rcpt@example.com>');
my ($ret, $note) = $self->hook_rcpt($self->qp->transaction, my ($ret, $note) = $self->hook_rcpt($self->qp->transaction, $address);
$address); is($ret, DENY, "Check we got a DENY ($note)");
is($ret, DENY, "Check we got a DENY"); #print("# dnsbl result: $note\n");
print("# dnsbl result: $note\n");
} }
sub test_hook_disconnect {
my $self = shift;
cmp_ok( DECLINED, '==', $self->hook_connect($self->qp->transaction),
"hook_disconnect +");
}