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;