qpsmtpd/plugins/dnsbl
Ask Bjørn Hansen 21a88f9f54 adjust logging. enable disconnect_handler again.
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@72 958fd67b-6ff1-0310-b445-bb7760255be9
2002-09-10 16:49:10 +00:00

108 lines
2.5 KiB
Plaintext

sub register {
my ($self, $qp) = @_;
$self->register_hook("connect", "connect_handler");
$self->register_hook("rcpt", "rcpt_handler");
$self->register_hook("disconnect", "disconnect_handler");
}
sub connect_handler {
my ($self, $transaction) = @_;
my $remote_ip = $self->qp->connection->remote_ip;
my %dnsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
return DECLINED unless %dnsbl_zones;
my $reversed_ip = join(".", reverse(split(/\./, $remote_ip)));
# we should queue these lookups in the background and just fetch the
# results in the first rcpt handler ... oh well.
my $res = new Net::DNS::Resolver;
my $sel = IO::Select->new();
for my $dnsbl (keys %dnsbl_zones) {
$self->log(7, "Checking $reversed_ip.$dnsbl in the background");
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
}
$self->qp->connection->notes('dnsbl_sockets', $sel);
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 $sel = $conn->notes('dnsbl_sockets') or return "";
my $result;
$self->log(8, "waiting for dnsbl dns");
# don't wait more than 5 seconds here
my @ready = $sel->can_read(5);
$self->log(8, "DONE waiting for dnsbl dns, got " , scalar @ready, " answers ...") ;
for my $socket (@ready) {
my $query = $res->bgread($socket);
undef $socket;
my $dnsbl;
if ($query) {
my $a_record = 0;
foreach my $rr ($query->answer) {
$a_record = 1 if $rr->type eq "A";
my $name = $rr->name;
($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
$dnsbl = $name unless $dnsbl;
$self->log(9, "name ", $rr->name);
next unless $rr->type eq "TXT";
$self->log(10, "got txt record");
$result = $rr->txtdata and last;
}
$a_record and $result = "Blocked by $dnsbl";
}
else {
$self->log(4, "$dnsbl query failed: ", $res->errorstring)
unless $res->errorstring eq "NXDOMAIN";
}
last if $result;
}
# if there was more to read; then forget it
$conn->notes('dnsbl_sockets', undef);
return $conn->notes('dnsbl', $result);
}
sub rcpt_handler {
my ($self, $transaction, $rcpt) = @_;
my $note = $self->process_sockets;
return (DENY, $note) if $note;
return DECLINED;
}
sub disconnect_handler {
my ($self, $transaction) = @_;
$self->qp->connection->notes('dnsbl_sockets', undef);
return DECLINED;
}
1;