fcbf3b0ad4
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@67 958fd67b-6ff1-0310-b445-bb7760255be9
95 lines
2.2 KiB
Plaintext
95 lines
2.2 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 $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 $sockets = $conn->notes('dnsbl_sockets') or return "";
|
|
|
|
my $result;
|
|
|
|
for my $socket (@{$sockets}) {
|
|
my $query = $res->bgread($socket->[1]);
|
|
my $dnsbl = $socket->[0];
|
|
undef $socket;
|
|
|
|
if ($query) {
|
|
my $a_record = 0;
|
|
foreach my $rr ($query->answer) {
|
|
$a_record = 1 if $rr->type eq "A";
|
|
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";
|
|
}
|
|
}
|
|
|
|
# if there were more to read; then forget about them again ...
|
|
undef $_ for (@{$sockets});
|
|
|
|
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) = @_;
|
|
|
|
my $sockets = $self->qp->connection->notes('dnsbl_sockets');
|
|
# if there were more to read; then forget about them again ...
|
|
undef $_ for (@{$sockets});
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
|
|
1;
|