dns_whitelist_soft: tiny tweaks of little consequence
This commit is contained in:
parent
8156341c6e
commit
3e223ef9dc
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user