Sorry about the wait. Had to get the patch approved.
--- Paranoid.pm.old 2015-08-31 12:49:35.000000000 -0400
+++ lib/Net/DNS/Paranoid.pm 2015-08-31 17:25:04.000000000 -0400
@@ -8,17 +8,32 @@
rw => [qw(timeout blocked_hosts whitelisted_hosts resolver)]
);
use Net::DNS;
+use Time::HiRes qw( alarm );
+use POSIX qw( ceil );
sub new {
my $class = shift;
my %args = @_ ==1 ? %{$_[0]} : @_;
- $args{resolver} ||= Net::DNS::Resolver->new;
+
+ $args{timeout} ||= 15;
+
+ unless ($args{resolver}) {
+ my $res = $args{resolver} = Net::DNS::Resolver->new(
+ # Calculate the nearest base 2 exponent that would cover the timeout period
+ # So, 1+2+4+8 = 15 seconds, which would be 4 retries
+ retrans => 1,
+ retry => ceil( log($args{timeout} + 1) / log(2) ),
+ udp_timeout => $args{timeout},
+ );
+
+ # no staggered retries, full time used is $timeout * $num_of_ns
+ my $num_of_ns = scalar $res->nameservers;
+ $res->tcp_timeout( ceil( $args{timeout} / $num_of_ns ) );
+ }
+
$args{whitelisted_hosts} ||= [];
$args{blocked_hosts} ||= [];
- bless {
- timeout => 15,
- %args
- }, $class;
+ bless { %args }, $class;
}
sub resolve {
@@ -41,22 +56,21 @@
# return the IP address if it looks like one and wasn't marked bad
return ([$host]) if $host =~ /^\d+\.\d+\.\d+\.\d+$/;
- my $sock = $res->bgsend($host)
- or return (undef, "No sock from bgsend");
-
- # wait for the socket to become readable, unless this is from our test
- # mock resolver.
- unless ($sock && $sock eq "MOCK") {
- my $rin = '';
- vec($rin, fileno($sock), 1) = 1;
- my $nf = select($rin, undef, undef, $self->_time_remain($start_time));
- return (undef, "DNS lookup timeout") unless $nf;
+ # Find the host using Resolver's send method, which supports timeouts
+ # and alternate NSs. Most of the time, this will use UDP, but may
+ # switch to TCP in certain situations.
+ my $packet;
+ local $SIG{ALRM} = sub { die "DNS lookup timeout\n" };
+ alarm $self->_time_remain($start_time);
+ eval { $packet = $res->send($host) };
+ alarm 0;
+
+ unless ($packet) {
+ my $errstr = $@ || "DNS send failure: ".$res->errorstring;
+ chomp $errstr;
+ return (undef, $errstr);
}
- my $packet = $res->bgread($sock)
- or return (undef, "DNS bgread failure");
- $sock = undef;
-
my @addr;
my $cname;
foreach my $rr ($packet->answer) {
--- MockResolver.pm.old 2015-08-31 12:58:19.000000000 -0400
+++ t/MockResolver.pm 2015-08-31 12:59:49.000000000 -0400
@@ -32,6 +32,11 @@
if $ENV{VERBOSE};
return $self->{next_fake_packet};
}
+ if ($method eq "send" && $fr->{$_[0]}) {
+ Test::More::note("mock DNS resolver doing fake send() of $_[0]\n")
+ if $ENV{VERBOSE};
+ return $fr->{$_[0]};
+ }
# No verbose conditional on this one because it shouldn't happen:
Test::More::note("Calling through to Net::DNS::Resolver proxy method '$method'");
return $self->{proxy}->$method(@_);
