diff --git a/Makefile.PL b/Makefile.PL index b30ea54..8ae2b99 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -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 diff --git a/lib/Qpsmtpd/Base.pm b/lib/Qpsmtpd/Base.pm index cfe88ff..f1612b9 100644 --- a/lib/Qpsmtpd/Base.pm +++ b/lib/Qpsmtpd/Base.pm @@ -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 $async_res; + eval 'use Net::DNS::Async'; + if ($@) { + warn "could not load Net::DNS::Async, is it installed?"; + return; + } + + my $res = Net::DNS::Resolver->new(dnsrch => 0); + $res->tcp_timeout(0); # Net::DNS::Async handles its own timeouts + $res->tcp_timeout(0); + + $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; diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm index 777bc97..62b3d12 100644 --- a/lib/Qpsmtpd/Plugin.pm +++ b/lib/Qpsmtpd/Plugin.pm @@ -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; diff --git a/lib/Qpsmtpd/SMTP.pm b/lib/Qpsmtpd/SMTP.pm index 01f54a7..ccc88d8 100644 --- a/lib/Qpsmtpd/SMTP.pm +++ b/lib/Qpsmtpd/SMTP.pm @@ -8,7 +8,6 @@ use Carp; #use Data::Dumper; use POSIX qw(strftime); use Mail::Header; -use Net::DNS; use Qpsmtpd; use Qpsmtpd::Connection; diff --git a/plugins/dns_whitelist_soft b/plugins/dns_whitelist_soft index b469dbb..252a6b3 100644 --- a/plugins/dns_whitelist_soft +++ b/plugins/dns_whitelist_soft @@ -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"); diff --git a/plugins/dnsbl b/plugins/dnsbl index c615332..2687d19 100644 --- a/plugins/dnsbl +++ b/plugins/dnsbl @@ -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}; -} - diff --git a/plugins/fcrdns b/plugins/fcrdns index 26af74e..a993dea 100644 --- a/plugins/fcrdns +++ b/plugins/fcrdns @@ -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}}) { diff --git a/plugins/helo b/plugins/helo index 8d29539..7c354f8 100644 --- a/plugins/helo +++ b/plugins/helo @@ -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 { diff --git a/plugins/resolvable_fromhost b/plugins/resolvable_fromhost index d25cae3..8bc610e 100644 --- a/plugins/resolvable_fromhost +++ b/plugins/resolvable_fromhost @@ -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 { diff --git a/plugins/rhsbl b/plugins/rhsbl index 4682c83..deb184f 100644 --- a/plugins/rhsbl +++ b/plugins/rhsbl @@ -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) { diff --git a/plugins/stunnel b/plugins/stunnel index 3bdf24c..86307e4 100644 --- a/plugins/stunnel +++ b/plugins/stunnel @@ -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; } diff --git a/plugins/uribl b/plugins/uribl index d06feb6..02fbc9d 100644 --- a/plugins/uribl +++ b/plugins/uribl @@ -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}); -} diff --git a/t/plugin_tests/helo b/t/plugin_tests/helo index 5adffe9..daa9a62 100644 --- a/t/plugin_tests/helo +++ b/t/plugin_tests/helo @@ -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; diff --git a/t/plugin_tests/resolvable_fromhost b/t/plugin_tests/resolvable_fromhost index 49341d9..899fca5 100644 --- a/t/plugin_tests/resolvable_fromhost +++ b/t/plugin_tests/resolvable_fromhost @@ -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 { diff --git a/t/qpsmtpd-base.t b/t/qpsmtpd-base.t index 1845ee5..b0ed7ef 100644 --- a/t/qpsmtpd-base.t +++ b/t/qpsmtpd-base.t @@ -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,45 @@ 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 { + eval 'use Net::DNS::Async'; + return if ($@); + 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)); +}