dnsbl,rhsbl: process DNS immediately
and use naughty for deferred rejection
This commit is contained in:
Matt Simerson
parent
2a0cf74969
commit
3427af8aa4
170
plugins/dnsbl
170
plugins/dnsbl
@ -176,44 +176,61 @@ sub hook_connect {
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
|
||||
|
||||
$self->initiate_lookups( \%dnsbl_zones, $reversed_ip );
|
||||
|
||||
my $message = $self->process_sockets or do {
|
||||
$self->log(LOGINFO, 'pass');
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
return $self->get_reject( $message );
|
||||
};
|
||||
|
||||
sub initiate_lookups {
|
||||
my ($self, $zones, $reversed_ip) = @_;
|
||||
|
||||
# we queue these lookups in the background and fetch the
|
||||
# results in the first rcpt handler
|
||||
|
||||
my $res = new Net::DNS::Resolver;
|
||||
$res->tcp_timeout(30);
|
||||
$res->udp_timeout(30);
|
||||
|
||||
my $sel = IO::Select->new();
|
||||
|
||||
my $dom;
|
||||
for my $dnsbl (keys %$zones) {
|
||||
for my $dnsbl (keys %dnsbl_zones) {
|
||||
# fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp
|
||||
$dom->{"$reversed_ip.$dnsbl"} = 1;
|
||||
if (defined($zones->{$dnsbl})) {
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record in the background");
|
||||
$sel->add($res->bgsend("$reversed_ip.$dnsbl"));
|
||||
my $query;
|
||||
if ( defined $dnsbl_zones{$dnsbl} ) {
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record");
|
||||
$query = $res->query("$reversed_ip.$dnsbl");
|
||||
}
|
||||
else {
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record in the background");
|
||||
$sel->add($res->bgsend("$reversed_ip.$dnsbl", "TXT"));
|
||||
$self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record");
|
||||
$query = $res->query("$reversed_ip.$dnsbl", "TXT");
|
||||
}
|
||||
|
||||
if ( ! $query) {
|
||||
if ( $res->errorstring ne "NXDOMAIN" ) {
|
||||
$self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring);
|
||||
};
|
||||
next;
|
||||
};
|
||||
|
||||
my $a_record = 0;
|
||||
my $result;
|
||||
foreach my $rr ($query->answer) {
|
||||
if ( $rr->type eq 'A' ) {
|
||||
$result = $rr->name;
|
||||
$self->log(LOGDEBUG, "found A for $result with IP " . $rr->address);
|
||||
}
|
||||
elsif ($rr->type eq 'TXT') {
|
||||
$self->log(LOGDEBUG, "found TXT, " . $rr->txtdata);
|
||||
$result = $rr->txtdata;
|
||||
};
|
||||
|
||||
next if ! $result;
|
||||
|
||||
if ( ! $dnsbl ) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); };
|
||||
if ( ! $dnsbl ) { $dnsbl = $result; };
|
||||
|
||||
if ($a_record) {
|
||||
if (defined $dnsbl_zones{$dnsbl}) {
|
||||
my $smtp_msg = $dnsbl_zones{$dnsbl};
|
||||
$smtp_msg =~ s/%IP%/$remote_ip/g;
|
||||
return $self->get_reject( $smtp_msg, $dnsbl );
|
||||
}
|
||||
return $self->get_reject( "Blocked by $dnsbl" );
|
||||
}
|
||||
|
||||
return $self->get_reject( $result, $dnsbl );
|
||||
}
|
||||
}
|
||||
|
||||
$self->connection->notes('dnsbl_sockets', $sel);
|
||||
$self->connection->notes('dnsbl_domains', $dom);
|
||||
$self->log(LOGINFO, 'pass');
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
sub is_set_rblsmtpd {
|
||||
@ -236,7 +253,7 @@ sub is_set_rblsmtpd {
|
||||
};
|
||||
|
||||
sub ip_whitelisted {
|
||||
my $self = shift;
|
||||
my ($self) = @_;
|
||||
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
|
||||
@ -256,93 +273,6 @@ sub return_env_message {
|
||||
return ( $self->get_reject_type(), join(' ', $msg, $result));
|
||||
}
|
||||
|
||||
sub process_sockets {
|
||||
my ($self) = @_;
|
||||
|
||||
my $conn = $self->qp->connection;
|
||||
|
||||
return $conn->notes('dnsbl') if $conn->notes('dnsbl');
|
||||
|
||||
my $sel = $conn->notes('dnsbl_sockets') or return '';
|
||||
my $dom = $conn->notes('dnsbl_domains');
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
|
||||
my %dnsbl_zones = map { (split /:/, $_, 2)[0,1] } $self->qp->config('dnsbl_zones');
|
||||
|
||||
my $result;
|
||||
my $res = new Net::DNS::Resolver;
|
||||
$res->tcp_timeout(30);
|
||||
$res->udp_timeout(30);
|
||||
|
||||
$self->log(LOGDEBUG, "waiting for dnsbl dns");
|
||||
|
||||
# don't wait more than 8 seconds here
|
||||
my @ready = $sel->can_read(8);
|
||||
|
||||
$self->log(LOGDEBUG, "done waiting for dnsbl dns, got ", scalar @ready, " answers ...");
|
||||
return '' unless @ready;
|
||||
|
||||
for my $socket (@ready) {
|
||||
my $query = $res->bgread($socket);
|
||||
$sel->remove($socket);
|
||||
undef $socket;
|
||||
|
||||
my $dnsbl;
|
||||
|
||||
if ($query) {
|
||||
my $a_record = 0;
|
||||
foreach my $rr ($query->answer) {
|
||||
my $name = $rr->name;
|
||||
$self->log(LOGDEBUG, "name $name");
|
||||
next unless $dom->{$name};
|
||||
$self->log(LOGDEBUG, "name $name was queried");
|
||||
$a_record = 1 if $rr->type eq "A";
|
||||
($dnsbl) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $dnsbl;
|
||||
$dnsbl = $name unless $dnsbl;
|
||||
next unless $rr->type eq "TXT";
|
||||
$self->log(LOGDEBUG, "got txt record");
|
||||
$result = $rr->txtdata and last;
|
||||
}
|
||||
#$a_record and $result = "Blocked by $dnsbl";
|
||||
|
||||
if ($a_record) {
|
||||
if (defined $dnsbl_zones{$dnsbl}) {
|
||||
$result = $dnsbl_zones{$dnsbl};
|
||||
#$result =~ s/%IP%/$ENV{'TCPREMOTEIP'}/g;
|
||||
$result =~ s/%IP%/$remote_ip/g;
|
||||
}
|
||||
else {
|
||||
# shouldn't get here?
|
||||
$result = "Blocked by $dnsbl";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->log(LOGERROR, "$dnsbl query failed: ", $res->errorstring)
|
||||
unless $res->errorstring eq "NXDOMAIN";
|
||||
}
|
||||
|
||||
if ($result) {
|
||||
#kill any other pending I/O
|
||||
$conn->notes('dnsbl_sockets', undef);
|
||||
$result = join("\n", $self->qp->config('dnsbl_rejectmsg'), $result);
|
||||
return $conn->notes('dnsbl', $result);
|
||||
}
|
||||
}
|
||||
|
||||
if ($sel->count) {
|
||||
# loop around if we have dns blacklists left to see results from
|
||||
return $self->process_sockets();
|
||||
}
|
||||
|
||||
# er, the following code doesn't make much sense anymore...
|
||||
|
||||
# if there was more to read; then forget it
|
||||
$conn->notes('dnsbl_sockets', undef);
|
||||
|
||||
return $conn->notes('dnsbl', $result);
|
||||
}
|
||||
|
||||
sub hook_rcpt {
|
||||
my ($self, $transaction, $rcpt, %param) = @_;
|
||||
|
||||
@ -356,11 +286,3 @@ sub hook_rcpt {
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub hook_disconnect {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$self->connection->notes('dnsbl_sockets', undef);
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
|
||||
203
plugins/rhsbl
203
plugins/rhsbl
@ -31,146 +31,111 @@ use warnings;
|
||||
use Qpsmtpd::Constants;
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, $denial ) = @_;
|
||||
if ( defined $denial and $denial =~ /^disconnect$/i ) {
|
||||
$self->{_rhsbl}->{DENY} = DENY_DISCONNECT;
|
||||
}
|
||||
else {
|
||||
$self->{_rhsbl}->{DENY} = DENY;
|
||||
}
|
||||
my ($self, $qp ) = (shift, shift);
|
||||
|
||||
my $denial;
|
||||
if ( @_ == 1 ) {
|
||||
$denial = shift;
|
||||
if ( defined $denial && $denial =~ /^disconnect$/i ) {
|
||||
$self->{_args}{reject_type} = 'disconnect';
|
||||
}
|
||||
else {
|
||||
$self->{_args}{reject_type} = 'perm';
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->{_args} = { @_ };
|
||||
};
|
||||
}
|
||||
|
||||
sub hook_mail {
|
||||
my ($self, $transaction, $sender, %param) = @_;
|
||||
my ($self, $transaction, $sender, %param) = @_;
|
||||
|
||||
return DECLINED if $self->is_immune();
|
||||
|
||||
if ($sender->format eq '<>') {
|
||||
$self->log(LOGINFO, 'skip, null sender');
|
||||
$self->log(LOGINFO, 'pass, null sender');
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
my %rhsbl_zones = map { (split /\s+/, $_, 2)[0,1] } $self->qp->config('rhsbl_zones');
|
||||
my %rhsbl_zones = $self->populate_zones() or return DECLINED;
|
||||
|
||||
if ( ! %rhsbl_zones ) {
|
||||
$self->log(LOGINFO, 'skip, no zones');
|
||||
return DECLINED;
|
||||
};
|
||||
my $res = $self->init_resolver();
|
||||
|
||||
my $res = new Net::DNS::Resolver;
|
||||
my $sel = IO::Select->new();
|
||||
my %rhsbl_zones_map = ();
|
||||
|
||||
# Perform any RHS lookups in the background. We just send the query packets
|
||||
# here and pick up any results in the RCPT handler.
|
||||
# MTAs gets confused when you reject mail during MAIL FROM:
|
||||
|
||||
push(my @hosts, $sender->host);
|
||||
#my $helo = $self->qp->connection->hello_host;
|
||||
#push(@hosts, $helo) if $helo && $helo ne $sender->host;
|
||||
my @hosts = $sender->host;
|
||||
for my $host (@hosts) {
|
||||
for my $rhsbl (keys %rhsbl_zones) {
|
||||
# fix to find TXT records, if the rhsbl_zones line doesn't have second field
|
||||
if (defined($rhsbl_zones{$rhsbl})) {
|
||||
$self->log(LOGDEBUG, "Checking $host.$rhsbl for A record in the background");
|
||||
$sel->add($res->bgsend("$host.$rhsbl"));
|
||||
} else {
|
||||
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record in the background");
|
||||
$sel->add($res->bgsend("$host.$rhsbl", "TXT"));
|
||||
}
|
||||
$rhsbl_zones_map{"$host.$rhsbl"} = $rhsbl_zones{$rhsbl};
|
||||
for my $rhsbl (keys %rhsbl_zones) {
|
||||
my $query;
|
||||
# fix to find TXT records, if the rhsbl_zones line doesn't have second field
|
||||
if (defined($rhsbl_zones{$rhsbl})) {
|
||||
$self->log(LOGDEBUG, "Checking $host.$rhsbl for A record");
|
||||
$query = $res->query("$host.$rhsbl");
|
||||
} else {
|
||||
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record");
|
||||
$query = $res->query("$host.$rhsbl", 'TXT');
|
||||
}
|
||||
|
||||
if ( ! $query) {
|
||||
if ( $res->errorstring ne 'NXDOMAIN' ) {
|
||||
$self->log(LOGCRIT, "query failed: ", $res->errorstring);
|
||||
};
|
||||
next;
|
||||
};
|
||||
|
||||
my $result;
|
||||
foreach my $rr ($query->answer) {
|
||||
$self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name);
|
||||
if ($rr->type eq 'A') {
|
||||
$self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address);
|
||||
$result = $rr->name;
|
||||
}
|
||||
elsif ($rr->type eq 'TXT') {
|
||||
$result = $rr->txtdata;
|
||||
$self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
|
||||
};
|
||||
|
||||
if ( $result ) {
|
||||
$self->log(LOGINFO, "fail, $result");
|
||||
|
||||
my $host = $transaction->sender->host;
|
||||
if ($result =~ /^$host\./ ) {
|
||||
return $self->get_reject( "Mail from $host rejected because it $result" );
|
||||
};
|
||||
|
||||
my $hello = $self->qp->connection->hello_host;
|
||||
return $self->get_reject( "Mail from HELO $hello rejected because it $result" );
|
||||
};
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
%{$self->{_rhsbl_zones_map}} = %rhsbl_zones_map;
|
||||
$transaction->notes('rhsbl_sockets', $sel);
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub hook_rcpt {
|
||||
my ($self, $transaction, $rcpt) = @_;
|
||||
|
||||
my $result = $self->process_sockets or do {
|
||||
$self->log(LOGINFO, "pass");
|
||||
return DECLINED;
|
||||
};
|
||||
|
||||
|
||||
if ( defined($self->{_rhsbl_zones_map}{$result}) ) {
|
||||
my $host = $transaction->sender->host;
|
||||
if ($result =~ /^$host\./ ) {
|
||||
return ($self->{_rhsbl}->{DENY}, "Mail from $host rejected because it " . $self->{_rhsbl_zones_map}{$result});
|
||||
} else {
|
||||
my $hello = $self->qp->connection->hello_host;
|
||||
return ($self->{_rhsbl}->{DENY}, "Mail from HELO $hello rejected because it " . $self->{_rhsbl_zones_map}{$result});
|
||||
}
|
||||
}
|
||||
return ($self->{_rhsbl}->{DENY}, $result);
|
||||
}
|
||||
|
||||
sub process_sockets {
|
||||
my ($self) = @_;
|
||||
my $trans = $self->transaction;
|
||||
my $result = '';
|
||||
sub populate_zones {
|
||||
my $self = shift;
|
||||
|
||||
return $trans->notes('rhsbl') if $trans->notes('rhsbl');
|
||||
my %rhsbl_zones
|
||||
= map { (split /\s+/, $_, 2)[0,1] }
|
||||
$self->qp->config('rhsbl_zones');
|
||||
|
||||
my $res = new Net::DNS::Resolver;
|
||||
my $sel = $trans->notes('rhsbl_sockets') or return '';
|
||||
if ( ! keys %rhsbl_zones ) {
|
||||
$self->log(LOGINFO, 'pass, no zones');
|
||||
return;
|
||||
};
|
||||
|
||||
$self->log(LOGDEBUG, 'waiting for rhsbl dns');
|
||||
return %rhsbl_zones;
|
||||
};
|
||||
|
||||
# don't wait more than 8 seconds here
|
||||
my @ready = $sel->can_read(8);
|
||||
|
||||
$self->log(LOGDEBUG, 'DONE waiting for rhsbl dns, got ' , scalar @ready, ' answers ...') ;
|
||||
return '' unless @ready;
|
||||
|
||||
for my $socket (@ready) {
|
||||
my $query = $res->bgread($socket);
|
||||
$sel->remove($socket);
|
||||
undef $socket;
|
||||
|
||||
if ($query) {
|
||||
foreach my $rr ($query->answer) {
|
||||
$self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name);
|
||||
if ($rr->type eq 'A') {
|
||||
$result = $rr->name;
|
||||
$self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address);
|
||||
last;
|
||||
} elsif ($rr->type eq 'TXT') {
|
||||
$result = $rr->txtdata;
|
||||
$self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata);
|
||||
last;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
$self->log(LOGCRIT, "query failed: ", $res->errorstring) unless $res->errorstring eq 'NXDOMAIN';
|
||||
}
|
||||
|
||||
if ($result) {
|
||||
#kill any other pending I/O
|
||||
$trans->notes('rhsbl_sockets', undef);
|
||||
return $trans->notes('rhsbl', $result);
|
||||
}
|
||||
}
|
||||
|
||||
if ($sel->count) {
|
||||
# loop around if we have dns results left
|
||||
return $self->process_sockets();
|
||||
}
|
||||
|
||||
# if there was more to read; then forget it
|
||||
$trans->notes('rhsbl_sockets', undef);
|
||||
|
||||
return $trans->notes('rhsbl', $result);
|
||||
}
|
||||
|
||||
sub hook_disconnect {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$transaction->notes('rhsbl_sockets', undef);
|
||||
return DECLINED;
|
||||
}
|
||||
sub init_resolver {
|
||||
my $self = shift;
|
||||
return $self->{_resolver} if $self->{_resolver};
|
||||
$self->log( LOGDEBUG, "initializing Net::DNS::Resolver");
|
||||
$self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
|
||||
my $timeout = $self->{_args}{timeout} || 8;
|
||||
$self->{_resolver}->tcp_timeout($timeout);
|
||||
$self->{_resolver}->udp_timeout($timeout);
|
||||
return $self->{_resolver};
|
||||
};
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user