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

Base: consistent DNS handling

Browse Source
This commit is contained in:
Matt Simerson 2014-11-05 18:02:58 -08:00
parent cd79bff78e
commit 38d5523b35
15 changed files with 156 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Makefile.PL
View File

@ -13,8 +13,8 @@ WriteMakefile(
'File::Temp' => 0,
'Mail::Header' => 0,
'MIME::Base64' => 0,
'Net::DNS' => 0.39,
'Net::IP' => 0,
'Net::DNS' => 0.79,
'Net::IP' => 1.26,
'Time::HiRes' => 0,
'IO::Socket::SSL' => 0,
'ClamAV::Client' => 0, # virus/clamdscan
@ -22,7 +22,7 @@ WriteMakefile(
'Test::More' => 0,
'Test::Output' => 0,
# modules for specific features
'Mail::DKIM' => 0,
'Mail::DKIM' => 0.40,
'File::Tail' => 0, # log/summarize, log/watch
'Time::TAI64' => 0, # log2sql
# 'DBI' => 0, # auth_vpopmail_sql and

64
lib/Qpsmtpd/Base.pm
View File

@ -1,6 +1,7 @@
package Qpsmtpd::Base;
use strict;
use Net::DNS;
use Net::IP;
sub new {
@ -45,4 +46,67 @@ sub is_ipv6 {
return Net::IP::ip_is_ipv6($ip);
};
sub get_resolver {
my ($self, %args) = @_;
return $self->{_resolver} if $self->{_resolver};
my $timeout = 5;
if (defined $args{timeout}) {
$timeout = delete $args{timeout};
}
$self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
$self->{_resolver}->tcp_timeout($timeout);
$self->{_resolver}->udp_timeout($timeout);
return $self->{_resolver};
}
sub get_async_resolver {
my ( $self, %args ) = @_;
return $self->{_async_resolver} if $self->{_async_resolver};
my $res = Net::DNS::Resolver->new(dnsrch => 0);
$res->tcp_timeout(0); # Net::DNS::Async handles its own timeouts
$res->tcp_timeout(0);
my $async_res;
eval 'use Net::DNS::Async';
if ($@) {
warn "Net::DNS::Async failed to load";
return;
}
$self->{_async_resolver} = Net::DNS::Async->new( %args );
$self->{_async_resolver}{Resolver} = $res;
return $self->{_async_resolver};
}
sub resolve_a {
my ($self, $name) = @_;
my $q = $self->get_resolver->query($name, 'A') or return;
return map { $_->address } grep { $_->type eq 'A' } $q->answer;
}
sub resolve_aaaa {
my ($self, $name) = @_;
my $q = $self->get_resolver->query($name, 'AAAA') or return;
return map { $_->address } grep { $_->type eq 'AAAA' } $q->answer;
}
sub resolve_mx {
my ($self, $name) = @_;
my $q = $self->get_resolver->query($name, 'MX') or return;
return map { $_->exchange } grep { $_->type eq 'MX' } $q->answer;
}
sub resolve_ns {
my ($self, $name) = @_;
my $q = $self->get_resolver->query($name, 'NS') or return;
return map { $_->nsdname } grep { $_->type eq 'NS' } $q->answer;
}
sub resolve_ptr {
my ($self, $name) = @_;
my $q = $self->get_resolver->query($name, 'PTR') or return;
return map { $_->ptrdname } grep { $_->type eq 'PTR' } $q->answer;
}
1;

15
lib/Qpsmtpd/Plugin.pm
View File

@ -2,8 +2,8 @@ package Qpsmtpd::Plugin;
use strict;
use warnings;
use Net::DNS;
use lib 'lib';
use parent 'Qpsmtpd::Base';
use Qpsmtpd::Constants;
# more or less in the order they will fire
@ -278,17 +278,6 @@ sub store_auth_results {
$self->qp->connection->notes('authentication_results', $ar );
};
sub init_resolver {
my $self = shift;
my $timeout = $self->{_args}{dns_timeout} || shift || 5;
return $self->{_resolver} if $self->{_resolver};
$self->log(LOGDEBUG, "initializing Net::DNS::Resolver");
$self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0);
$self->{_resolver}->tcp_timeout($timeout);
$self->{_resolver}->udp_timeout($timeout);
return $self->{_resolver};
}
sub is_immune {
my $self = shift;

1
lib/Qpsmtpd/SMTP.pm
View File

@ -8,7 +8,6 @@ use Carp;
#use Data::Dumper;
use POSIX qw(strftime);
use Mail::Header;
use Net::DNS;
use Qpsmtpd;
use Qpsmtpd::Connection;

6
plugins/dns_whitelist_soft
View File

@ -68,10 +68,10 @@ sub hook_connect {
my $reversed_ip = join('.', reverse(split(/\./, $remote_ip)));
# we queue these lookups in the background and just fetch the
# queue lookups in the background and fetch the
# results in the first rcpt handler
my $res = new Net::DNS::Resolver;
my $res = $self->get_resolver();
my $sel = IO::Select->new();
for my $dnsbl (keys %whitelist_zones) {
@ -90,7 +90,7 @@ sub process_sockets {
return $conn->notes('whitelisthost') if $conn->notes('whitelisthost');
my $res = new Net::DNS::Resolver;
my $res = $self->get_resolver();
my $sel = $conn->notes('whitelist_sockets') or return '';
$self->log(LOGDEBUG, "waiting for whitelist dns");

16
plugins/dnsbl
View File

@ -166,7 +166,9 @@ sub hook_connect {
return DECLINED if $self->ip_whitelisted();
my $dnsbl_zones = $self->get_dnsbl_zones() or return DECLINED;
my $resolv = $self->get_resolver() or return DECLINED;
my $timeout = $self->{_args}{timeout} || 30;
my $resolv = $self->{_resolver} = $self->get_resolver(timeout=>$timeout)
or return DECLINED;
for my $dnsbl (keys %$dnsbl_zones) {
@ -299,15 +301,3 @@ sub hook_rcpt {
return DECLINED;
}
sub get_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} || 30;
$self->{_resolver}->tcp_timeout($timeout);
$self->{_resolver}->udp_timeout($timeout);
return $self->{_resolver};
}

6
plugins/fcrdns
View File

@ -141,8 +141,6 @@ sub register {
$self->{_args}{reject} = 0;
}
$self->init_resolver() or return;
$self->register_hook('connect', 'connect_handler');
}
@ -205,7 +203,7 @@ sub is_not_fqdn {
sub has_reverse_dns {
my ($self) = @_;
my $res = $self->init_resolver();
my $res = $self->get_resolver();
my $ip = $self->qp->connection->remote_ip;
my $query = $res->query($ip, 'PTR') or do {
@ -252,7 +250,7 @@ sub has_reverse_dns {
sub has_forward_dns {
my ($self) = @_;
my $res = $self->init_resolver();
my $res = $self->get_resolver();
foreach my $host (keys %{$self->{_args}{ptr_hosts}}) {

6
plugins/helo
View File

@ -244,7 +244,7 @@ sub register {
$self->{_args}{reject} = 1;
}
$self->populate_tests();
$self->init_resolver() or return;
$self->get_resolver() or return;
$self->register_hook('helo', 'helo_handler');
$self->register_hook('ehlo', 'helo_handler');
@ -402,7 +402,7 @@ sub no_forward_dns {
return if $self->is_address_literal($host);
my $res = $self->init_resolver();
my $res = $self->get_resolver();
$host = "$host." if $host !~ /\.$/; # fully qualify name
my $query = $res->query($host);
@ -431,7 +431,7 @@ sub no_forward_dns {
sub no_reverse_dns {
my ($self, $host, $ip) = @_;
my $res = $self->init_resolver();
my $res = $self->get_resolver();
$ip ||= $self->qp->connection->remote_ip;
my $query = $res->query($ip) or do {

51
plugins/resolvable_fromhost
View File

@ -92,6 +92,8 @@ sub register {
$self->{_args}{reject} = 1;
}
$self->{_args}{reject_type} ||= 'soft';
$self->{resolver} = $self->get_resolver(timeout => 30);
}
sub hook_mail {
@ -158,16 +160,14 @@ sub check_dns {
return 1;
}
my $res = new Net::DNS::Resolver(dnsrch => 0);
$res->tcp_timeout(30);
$res->udp_timeout(30);
my $res = $self->get_resolver(timeout => 30);
my $has_mx = $self->get_and_validate_mx($res, $host, $transaction);
my $has_mx = $self->get_and_validate_mx($host, $transaction);
return 1 if $has_mx == 1; # success, has MX!
return if $has_mx == -1; # has invalid MX records
# at this point, no MX for fh is resolvable
my @host_answers = $self->get_host_records($res, $host, $transaction);
my @host_answers = $self->get_host_records($host, $transaction);
foreach my $rr (@host_answers) {
if ($rr->type eq 'A' || $rr->type eq 'AAAA') {
$self->log(LOGINFO, "pass, found A for $host");
@ -198,9 +198,9 @@ sub ip_is_valid {
}
sub get_and_validate_mx {
my ($self, $res, $host, $transaction) = @_;
my ($self, $host, $transaction) = @_;
my @mx = mx($res, $host);
my @mx = mx($self->{resolver}, $host);
if (!scalar @mx) { # no mx records
$self->adjust_karma(-1);
$self->log(LOGINFO, "$host has no MX");
@ -225,9 +225,10 @@ sub get_and_validate_mx {
}
sub get_host_records {
my ($self, $res, $host, $transaction) = @_;
my ($self, $host, $transaction) = @_;
my @answers;
my $res = $self->{resolver};
my $query = $res->search($host);
if ($query) {
@ -259,38 +260,26 @@ sub mx_address_resolves {
my ($self, $name, $fromhost) = @_;
# IP in MX
return $self->ip_is_valid($name) if ip_is_ipv4($name) || ip_is_ipv6($name);
if (ip_is_ipv4($name) || ip_is_ipv6($name)) {
return $self->ip_is_valid($name);
};
my $res = $self->get_resolver();
my @mx_answers = $self->resolve_a($name);
my $res = new Net::DNS::Resolver(dnsrch => 0);
my @mx_answers;
my $query = $res->search($name, 'A');
if ($query) {
foreach my $rrA ($query->answer) {
push(@mx_answers, $rrA);
}
}
if ($has_ipv6) {
my $query = $res->search($name, 'AAAA');
if ($query) {
foreach my $rrAAAA ($query->answer) {
push(@mx_answers, $rrAAAA);
}
}
push @mx_answers, $self->resolve_aaaa($name);
}
if (!@mx_answers) {
if ($res->errorstring eq 'NXDOMAIN') {
$self->log(LOGWARN, "fail, query for $fromhost, ",
$res->errorstring);
$self->log(LOGWARN, "fail, query for $fromhost, ", $res->errorstring);
}
return;
}
foreach my $rr (@mx_answers) {
next if ($rr->type ne 'A' && $rr->type ne 'AAAA');
return $self->ip_is_valid($rr->address);
}
return;
return if ! scalar @mx_answers;
return $self->ip_is_valid($mx_answers[0]);
}
sub populate_invalid_networks {

2
plugins/rhsbl
View File

@ -67,7 +67,7 @@ sub hook_mail {
my %rhsbl_zones = $self->populate_zones() or return DECLINED;
my $res = $self->init_resolver();
my $res = $self->get_resolver();
my @hosts = $sender->host;
for my $host (@hosts) {

9
plugins/stunnel
View File

@ -61,13 +61,8 @@ sub stunnel {
$self->log(LOGINFO, "stunnel : $2:$4");
# DNS reverse
my $res = $self->init_resolver();
if (my $query = $res->query($self->connection->remote_ip, 'PTR')) {
foreach my $rr ($query->answer) {
next if $rr->type ne 'PTR';
$self->connection->remote_host($rr->ptrdname);
}
}
my @ptrs = $self->resolve_ptr($self->connection->remote_ip);
$self->connection->remote_host($ptrs[0]);
return DONE;
}

9
plugins/uribl
View File

@ -92,9 +92,9 @@ may be used and redistributed under the same terms as qpsmtpd itself.
use strict;
use warnings;
use lib 'lib';
use Qpsmtpd::Constants;
use Net::DNS::Resolver;
use Time::HiRes qw(time);
use IO::Select;
@ -180,7 +180,7 @@ sub init {
my @whitelist = $self->qp->config('uribl_whitelist_domains');
$self->{whitelist_zones} = {(map { ($_ => 1) } @whitelist)};
$self->init_resolver;
$self->{resolver} = $self->get_resolver(timeout => $self->{timeout});
}
sub send_query {
@ -533,8 +533,3 @@ sub hook_data {
return DECLINED;
}
sub init_resolver {
my $self = shift;
$self->{resolver} = new Net::DNS::Resolver or return;
$self->{resolver}->udp_timeout($self->{timeout});
}

9
t/plugin_tests/helo
View File

@ -8,7 +8,6 @@ use Qpsmtpd::Constants;
sub register_tests {
my $self = shift;
$self->register_test('test_init_resolver');
$self->register_test('test_is_in_badhelo');
$self->register_test('test_is_regex_match');
$self->register_test('test_invalid_localhost');
@ -24,17 +23,9 @@ sub register_tests {
sub test_helo_handler {
my $self = shift;
cmp_ok( $self->helo_handler(undef, undef), '==', DECLINED, "empty host");
};
sub test_init_resolver {
my $self = shift;
my $net_dns = $self->init_resolver();
ok( $net_dns, "net::dns" );
cmp_ok( ref $net_dns, 'eq', 'Net::DNS::Resolver', "ref ok");
};
sub test_is_in_badhelo {
my $self = shift;

10
t/plugin_tests/resolvable_fromhost
View File

@ -3,11 +3,9 @@
use strict;
use warnings;
use Net::DNS;
use Qpsmtpd::Address;
use Qpsmtpd::Constants;
my $res = new Net::DNS::Resolver(dnsrch => 0);
my $test_email = 'user@example.com';
sub register_tests {
@ -60,17 +58,17 @@ sub test_get_and_validate_mx {
my $self = shift;
my $transaction = $self->qp->transaction;
ok( scalar $self->get_and_validate_mx( $res, 'perl.com', $transaction ) );
ok( scalar $self->get_and_validate_mx( 'perl.com', $transaction ) );
ok( ! scalar $self->get_host_records( $res, 'fake-domain-name-for-test.com', $transaction ) );
ok( ! scalar $self->get_host_records( 'fake-domain-name-for-test.com', $transaction ) );
};
sub test_get_host_records {
my $self = shift;
my $transaction = $self->qp->transaction;
ok( scalar $self->get_host_records( $res, 'perl.com', $transaction ) );
ok( ! scalar $self->get_host_records( $res, 'fake-domain-name-for-test.com', $transaction ) );
ok( scalar $self->get_host_records( 'perl.com', $transaction ) );
ok( ! scalar $self->get_host_records( 'fake-domain-name-for-test.com', $transaction ) );
};
sub test_mx_address_resolves {

47
t/qpsmtpd-base.t
View File

@ -16,6 +16,13 @@ my $base = Qpsmtpd::Base->new();
__tildeexp();
__is_localhost();
__is_valid_ip();
__get_resolver();
__get_async_resolver();
__resolve_a();
__resolve_aaaa();
__resolve_mx();
__resolve_ns();
__resolve_ptr();
done_testing();
@ -49,3 +56,43 @@ sub __tildeexp {
$path = $base->tildeexp('no/tilde/in/path');
cmp_ok( $path, 'eq', 'no/tilde/in/path', 'tildeexp, no expansion');
};
sub __get_resolver {
my $res = $base->get_resolver();
isa_ok( $res, 'Net::DNS::Resolver', "get_resolver returns a Net::DNS::Resolver");
}
sub __get_async_resolver {
my $res = $base->get_async_resolver() or return;
isa_ok( $res, 'Net::DNS::Async', "resolver object, $res");
isa_ok( $res->{Resolver}, 'Net::DNS::Resolver', "resolver object, $res");
}
sub __resolve_a {
my @r = $base->resolve_a('simerson.net');
ok(@r, "resolve_a: " . join(',', @r));
}
sub __resolve_aaaa {
my @r = $base->resolve_aaaa('ns2.cadillac.net');
ok(@r, "resolve_aaaa: " . join(',', @r));
}
sub __resolve_mx {
my @r = $base->resolve_mx('simerson.net');
ok(@r, "resolve_mx: " . join(',', @r));
}
sub __resolve_ns {
my @r = $base->resolve_ns('simerson.net');
ok(@r, "resolve_ns: " . join(', ', @r));
}
sub __resolve_ptr {
my @r = $base->resolve_ptr('163.51.128.66.in-addr.arpa.');
ok(@r, "resolve_ptr: FQDN: " . join(', ', @r));
@r = $base->resolve_ptr('66.128.51.163');
ok(@r, "resolve_ptr, IP: " . join(', ', @r));
}