byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

dnsbl,rhsbl: process DNS immediately

Browse Source 
and use naughty for deferred rejection
This commit is contained in:
Matt Simerson 2012-06-23 03:10:48 -04:00
parent 2143701113
commit a6cfb68392
2 changed files with 130 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

170
plugins/dnsbl
View File

@ -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;
}

177
plugins/rhsbl
View File

@ -31,13 +31,21 @@ use warnings;
use Qpsmtpd::Constants;
sub register {
my ($self, $qp, $denial ) = @_;
if ( defined $denial and $denial =~ /^disconnect$/i ) {
$self->{_rhsbl}->{DENY} = DENY_DISCONNECT;
my ($self, $qp ) = (shift, shift);
my $denial;
if ( @_ == 1 ) {
$denial = shift;
if ( defined $denial && $denial =~ /^disconnect$/i ) {
$self->{_args}{reject_type} = 'disconnect';
}
else {
$self->{_rhsbl}->{DENY} = DENY;
$self->{_args}{reject_type} = 'perm';
}
}
else {
$self->{_args} = { @_ };
};
}
sub hook_mail {
@ -46,131 +54,88 @@ sub hook_mail {
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
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 in the background");
$sel->add($res->bgsend("$host.$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 in the background");
$sel->add($res->bgsend("$host.$rhsbl", "TXT"));
}
$rhsbl_zones_map{"$host.$rhsbl"} = $rhsbl_zones{$rhsbl};
}
$self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record");
$query = $res->query("$host.$rhsbl", 'TXT');
}
%{$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 ( ! $query) {
if ( $res->errorstring ne 'NXDOMAIN' ) {
$self->log(LOGCRIT, "query failed: ", $res->errorstring);
};
next;
};
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 = '';
return $trans->notes('rhsbl') if $trans->notes('rhsbl');
my $res = new Net::DNS::Resolver;
my $sel = $trans->notes('rhsbl_sockets') or return '';
$self->log(LOGDEBUG, 'waiting for rhsbl dns');
# 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) {
my $result;
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->name;
}
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 ( $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" );
};
}
}
}
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);
$self->log(LOGINFO, "pass");
return DECLINED;
}
sub populate_zones {
my $self = shift;
my %rhsbl_zones
= map { (split /\s+/, $_, 2)[0,1] }
$self->qp->config('rhsbl_zones');
if ( ! keys %rhsbl_zones ) {
$self->log(LOGINFO, 'pass, no zones');
return;
};
return %rhsbl_zones;
};
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};
};