async dns lookups in dnsbl plugin

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@66 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2002-09-10 13:36:58 +00:00
parent 2fd504ce6a
commit a7ac715289
2 changed files with 47 additions and 11 deletions

View File

@ -1,4 +1,9 @@
2002/09/10 2002/09/10
dnsbl plugin queues lookups in the background upon connect but
doesn't block for the results until they are needed, greatly
speeding up connection times. Also fix a typo in the dnsbl plugin
so it'll actually work(!).
check_badmailfrom and check_badrcptto plugins (Jim Winstead check_badmailfrom and check_badrcptto plugins (Jim Winstead
<jimw@trainedmonkey.com>) <jimw@trainedmonkey.com>)

View File

@ -12,18 +12,43 @@ sub connect_handler {
my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones'); my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
return unless %dnsbl_zones; return unless %dnsbl_zones;
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip))); my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
# we should queue these lookups in the background and just fetch the # we should queue these lookups in the background and just fetch the
# results in the first rcpt handler ... oh well. # results in the first rcpt handler ... oh well.
my $result = ""; my $res = new Net::DNS::Resolver;
my $sockets = [];
for my $dnsbl (keys %dnsbl_zones) {
$self->log(5, "Checking $reversed_ip.$dnsbl");
push @{$sockets}, [$dnsbl, $res->bgsend("$reversed_ip.$dnsbl", "TXT")];
}
$self->qp->connection->notes('dnsbl_sockets', $sockets);
return DECLINED;
}
sub process_sockets {
my ($self) = @_;
my $conn = $self->qp->connection;
return $conn->notes('dnsbl')
if $conn->notes('dnsbl');
my $res = new Net::DNS::Resolver; my $res = new Net::DNS::Resolver;
for my $dnsbl (keys %dnsbl_zones) { my $sockets = $conn->notes('dnsbl_sockets') or return "";
$self->log(3, "Checking $reversed_ip.$dnsbl");
my $query = $res->query("$reversed_ip.$dnsbl", "TXT"); my $result;
for my $socket (@{$sockets}) {
my $query = $res->bgread($socket->[1]);
my $dnsbl = $socket->[0];
undef $socket;
if ($query) { if ($query) {
my $a_record = 0; my $a_record = 0;
foreach my $rr ($query->answer) { foreach my $rr ($query->answer) {
@ -35,26 +60,32 @@ sub connect_handler {
$a_record and $result = "Blocked by $dnsbl"; $a_record and $result = "Blocked by $dnsbl";
} }
else { else {
warn "$$ query for $reversed_ip.$dnsbl failed: ", $res->errorstring, "\n" $self->log(4, "$dnsbl query failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN"; unless $res->errorstring eq "NXDOMAIN";
} }
} }
$transaction->notes('dnsbl', $result); # if there were more to read; then forget about them again ...
undef $_ for (@{$sockets});
return $conn->notes('dnsbl', $result);
return DECLINED;
} }
sub rcpt_handler { sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_; my ($self, $transaction, $rcpt) = @_;
my $note = $transaction->notes('rhsbl'); my $note = $self->process_sockets;
return (DENY, $note) if $note; return (DENY, $note) if $note;
return DECLINED; return DECLINED;
} }
sub disconnect_handler { sub disconnect_handler {
# if we queued stuff in the background we should make sure it got my ($self, $transaction) = @_;
# cleaned up here.
my $sockets = $self->qp->connection->notes('dnsbl_sockets');
# if there were more to read; then forget about them again ...
undef $_ for (@{$sockets});
return DECLINED; return DECLINED;
} }