dns_whitelist_soft: tiny tweaks of little consequence

This commit is contained in:
Matt Simerson 2012-06-23 00:43:20 -04:00
parent 8156341c6e
commit 3e223ef9dc

View File

@ -1,4 +1,5 @@
#!perl -w
=head1 NAME
dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins
@ -48,6 +49,17 @@ 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) = @_;
@ -58,7 +70,7 @@ sub hook_connect {
return DECLINED unless %whitelist_zones;
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
# we queue these lookups in the background and just fetch the
# results in the first rcpt handler
@ -68,11 +80,10 @@ sub hook_connect {
for my $dnsbl (keys %whitelist_zones) {
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
$sel->add($res->bgsend("$reversed_ip.$dnsbl", 'TXT'));
}
$self->connection->notes('whitelist_sockets', $sel);
return DECLINED;
}
@ -81,23 +92,22 @@ sub process_sockets {
my $conn = $self->connection;
return $conn->notes('whitelisthost')
if $conn->notes('whitelisthost');
return $conn->notes('whitelisthost') if $conn->notes('whitelisthost');
my $res = new Net::DNS::Resolver;
my $sel = $conn->notes('whitelist_sockets') or return "";
my $result;
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 ",
$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);
@ -108,12 +118,12 @@ sub process_sockets {
if ($query) {
my $a_record = 0;
foreach my $rr ($query->answer) {
$a_record = 1 if $rr->type eq "A";
$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, 'name ', $rr->name);
next unless $rr->type eq 'TXT';
$self->log(LOGDEBUG, "got txt record");
$result = $rr->txtdata and last;
}
@ -121,7 +131,7 @@ sub process_sockets {
}
else {
$self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN";
if $res->errorstring ne "NXDOMAIN";
}
if ($result) {
@ -142,12 +152,11 @@ sub process_sockets {
$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 || return (DECLINED);
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");
@ -155,4 +164,3 @@ sub hook_rcpt {
return DECLINED;
}
1;