Hello community, here is the log from the commit of package perl-Net-DNS for openSUSE:Factory checked in at 2018-12-08 11:19:50 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Net-DNS (Old) and /work/SRC/openSUSE:Factory/.perl-Net-DNS.new.19453 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Net-DNS" Sat Dec 8 11:19:50 2018 rev:54 rq:655786 version:1.19 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Net-DNS/perl-Net-DNS.changes 2018-10-01 08:14:28.422081264 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Net-DNS.new.19453/perl-Net-DNS.changes 2018-12-08 11:19:55.326865094 +0100 @@ -1,0 +2,6 @@ +Thu Dec 6 15:57:48 UTC 2018 - Stephan Kulow <[email protected]> + +- updated to 1.19 + see /usr/share/doc/packages/perl-Net-DNS/Changes + +------------------------------------------------------------------- Old: ---- Net-DNS-1.18.tar.gz New: ---- Net-DNS-1.19.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Net-DNS.spec ++++++ --- /var/tmp/diff_new_pack.vno5YM/_old 2018-12-08 11:19:57.426863085 +0100 +++ /var/tmp/diff_new_pack.vno5YM/_new 2018-12-08 11:19:57.426863085 +0100 @@ -17,13 +17,13 @@ Name: perl-Net-DNS -Version: 1.18 +Version: 1.19 Release: 0 %define cpan_name Net-DNS Summary: Perl Interface to the Domain Name System License: MIT Group: Development/Libraries/Perl -Url: http://search.cpan.org/dist/Net-DNS/ +Url: https://metacpan.org/release/%{cpan_name} Source0: https://cpan.metacpan.org/authors/id/N/NL/NLNETLABS/%{cpan_name}-%{version}.tar.gz Source1: cpanspec.yml BuildArch: noarch @@ -58,11 +58,11 @@ %setup -q -n %{cpan_name}-%{version} %build -%{__perl} Makefile.PL INSTALLDIRS=vendor -%{__make} %{?_smp_mflags} +perl Makefile.PL INSTALLDIRS=vendor +make %{?_smp_mflags} %check -%{__make} test +make test %install %perl_make_install ++++++ Net-DNS-1.18.tar.gz -> Net-DNS-1.19.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/Changes new/Net-DNS-1.19/Changes --- old/Net-DNS-1.18/Changes 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/Changes 2018-11-14 16:46:06.000000000 +0100 @@ -1,4 +1,17 @@ -$Id: Changes 1715 2018-09-21 14:17:46Z willem $ -*-text-*- +$Id: Changes 1722 2018-11-14 15:45:37Z willem $ -*-text-*- + + +**** 1.19 Nov 14, 2018 + + Show structure of EDNS options using Perl-like syntax. + +Fix rt.cpan.org #127557 + + Net::DNS::Resolver::Base should use 3 args open + +Fix rt.cpan.org #127182 + + Incorrect logic can cause DNS search to emit fruitless queries. **** 1.18 Sep 21, 2018 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/META.json new/Net-DNS-1.19/META.json --- old/Net-DNS-1.18/META.json 2018-09-21 16:18:16.000000000 +0200 +++ new/Net-DNS-1.19/META.json 2018-11-14 16:46:12.000000000 +0100 @@ -55,6 +55,6 @@ } }, "release_status" : "stable", - "version" : "1.18", + "version" : "1.19", "x_serialization_backend" : "JSON::PP version 2.27400_02" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/META.yml new/Net-DNS-1.19/META.yml --- old/Net-DNS-1.18/META.yml 2018-09-21 16:18:16.000000000 +0200 +++ new/Net-DNS-1.19/META.yml 2018-11-14 16:46:12.000000000 +0100 @@ -36,5 +36,5 @@ Test::More: '0.52' Time::Local: '1.19' perl: '5.006' -version: '1.18' +version: '1.19' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/Makefile.PL new/Net-DNS-1.19/Makefile.PL --- old/Net-DNS-1.18/Makefile.PL 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/Makefile.PL 2018-11-14 16:46:06.000000000 +0100 @@ -1,5 +1,5 @@ # -# $Id: Makefile.PL 1713 2018-09-12 05:57:50Z willem $ -*-perl-*- +# $Id: Makefile.PL 1719 2018-11-04 05:01:43Z willem $ -*-perl-*- # use strict; @@ -69,7 +69,7 @@ delete $optional{'Net::DNS::SEC'}; ## Note: MUST NOT be installed automatically -use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1;'; +use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1'; use constant INET_FALLBACK => !USE_SOCKET_IP && eval 'require IO::Socket::INET'; @@ -232,12 +232,12 @@ s|([/])[/]+|$1|g; # remove gratuitous //s } - eval 'require Net::DNS'; + eval 'require Net::DNS; $Net::DNS::VERSION =~ s/(\.\d)$/${1}0/'; my @version = grep $_, ( 'version', $Net::DNS::VERSION ); - my $nameregex = '\W+Net\WDNS.pm$'; + my $nameregex = '\W+Net\W+DNS.pm$'; my @installed = grep $_ && m/$nameregex/io, values %INC; - my %noinstall; + my %occluded; foreach (@installed) { my $path = $1 if m/^(.+)$nameregex/i; @@ -247,11 +247,11 @@ last if $_ eq $path; } foreach ( grep !$seen{$_}, @INC ) { - $noinstall{$_}++; # mark hidden libraries + $occluded{$_}++; # suppress install } } - return $self->SUPER::install(@_) unless $noinstall{$install_site}; + return $self->SUPER::install(@_) unless $occluded{$install_site}; my $message; warn $message = <<"AMEN"; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/RR/IPSECKEY.pm new/Net-DNS-1.19/lib/Net/DNS/RR/IPSECKEY.pm --- old/Net-DNS-1.18/lib/Net/DNS/RR/IPSECKEY.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/RR/IPSECKEY.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::RR::IPSECKEY; # -# $Id: IPSECKEY.pm 1597 2017-09-22 08:04:02Z willem $ +# $Id: IPSECKEY.pm 1718 2018-10-22 14:39:29Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1597 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1718 $)[1]; use strict; @@ -149,7 +149,7 @@ $self->{gateway} = new Net::DNS::DomainName($_); last; }; - croak "unrecognised gateway type"; + croak 'unrecognised gateway type'; } if ( defined wantarray ) { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/RR/OPT.pm new/Net-DNS-1.19/lib/Net/DNS/RR/OPT.pm --- old/Net-DNS-1.18/lib/Net/DNS/RR/OPT.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/RR/OPT.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::RR::OPT; # -# $Id: OPT.pm 1605 2017-11-27 11:37:40Z willem $ +# $Id: OPT.pm 1717 2018-10-12 13:14:42Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1605 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1717 $)[1]; use strict; @@ -72,9 +72,8 @@ my $flags = sprintf '%04x', $self->flags; my $rcode = $self->rcode; my $size = $self->size; - my @option = sort { $a <=> $b } $self->options; - my @lines = map $self->_format_option($_), @option; - my @format = join "\n;;\t\t", @lines; + my @option = map join( "\n;;\t\t\t\t", $self->_format_option($_) ), $self->options; + my @format = join "\n;;\t\t", @option; $rcode = 0 if $rcode < 16; # weird: 1 .. 15 not EDNS codes!! @@ -144,7 +143,7 @@ sub options { my ($self) = @_; my $options = $self->{option} || {}; - return keys %$options; + my @options = sort { $a <=> $b } keys %$options; } sub option { @@ -164,8 +163,9 @@ my $package = join '::', __PACKAGE__, $option; $package =~ s/-/_/g; my $defined = length($payload) && $package->can('_image'); - my @payload = $defined ? eval { $package->_image($payload) } : unpack 'H*', $payload; - Net::DNS::RR::_wrap( "$option\t=> (", @payload, ')' ); + my @element = $defined ? eval { $package->_image($payload) } : unpack 'H*', $payload; + my $protect = pop(@element); + Net::DNS::RR::_wrap( "$option\t=> (", map( "$_,", @element ), $protect, ')' ); } @@ -188,6 +188,7 @@ my $options = $self->{option} ||= {}; delete $options->{$number}; + return unless defined $value; if ( ref($value) || scalar(@etc) ) { my $option = ednsoptionbyval($number); my @arg = ( $value, @etc ); @@ -202,7 +203,7 @@ $value = $package->_compose(@arg); } } - $options->{$number} = $value if defined $value; + $options->{$number} = $value; } @@ -258,7 +259,10 @@ my @payload = map { ( $_ => $hash{$_} ) } @field; } -sub _image { &_decompose; } +sub _image { + my %hash = &_decompose; + my @image = map "$_ => $hash{$_}", @field; +} package Net::DNS::RR::OPT::EXPIRE; # RFC7314 @@ -272,7 +276,7 @@ my @payload = ( 'EXPIRE-TIMER' => unpack 'N', $_[1] ); } -sub _image { &_decompose; } +sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::COOKIE; # RFC7873 @@ -286,11 +290,15 @@ sub _decompose { my %hash; - my $template = ( length( $_[1] ) < 16 ) ? 'a8' : 'a8 a*'; - @hash{@key} = unpack $template, $_[1]; + @hash{@key} = unpack 'a8 a*', $_[1]; my @payload = map { ( $_ => $hash{$_} ) } @key; } +sub _image { + my %hash = &_decompose; + my @image = map join( ' => ', $_, unpack 'H*', $hash{$_} ), @key; +} + package Net::DNS::RR::OPT::TCP_KEEPALIVE; # RFC7828 @@ -300,10 +308,10 @@ } sub _decompose { - my @payload = ( TIMEOUT => unpack 'n', $_[1] ); + my @payload = ( 'TIMEOUT' => unpack 'n', $_[1] ); } -sub _image { &_decompose; } +sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::PADDING; # RFC7830 @@ -318,7 +326,7 @@ my @payload = ( 'OPTION-LENGTH' => length( $_[1] ) ); } -sub _image { &_decompose; } +sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::CHAIN; # RFC7901 @@ -327,7 +335,7 @@ sub _compose { my ( $class, %argument ) = @_; my ($trust_point) = values %argument; - Net::DNS::DomainName->new( $trust_point || return '' )->encode; + Net::DNS::DomainName->new($trust_point)->encode; } sub _decompose { @@ -336,7 +344,7 @@ my @payload = ( 'CLOSEST-TRUST-POINT' => $fqdn ); } -sub _image { &_decompose; } +sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::KEY_TAG; # RFC8145 @@ -374,7 +382,11 @@ ;; flags: 8000 ;; rcode: NOERROR ;; size: 1280 - ;; option: COOKIE => ( 7261776279746573 ) + ;; option: DAU => ( 8, 10, 13, 14, 15, 16 ) + ;; DHU => ( 1, 2, 4 ) + ;; COOKIE => ( CLIENT-COOKIE => 7261776279746573, + ;; SERVER-COOKIE => ) + =head1 DESCRIPTION @@ -458,10 +470,10 @@ %hash = $packet->edns->option(10); - { - 'CLIENT-COOKIE' => 'rawbytes', - 'SERVER-COOKIE' => undef - }; + %hash = ( + 'CLIENT-COOKIE' => 'rawbytes', + 'SERVER-COOKIE' => '' + ); For some options, an array is more appropriate: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/RR/TSIG.pm new/Net-DNS-1.19/lib/Net/DNS/RR/TSIG.pm --- old/Net-DNS-1.18/lib/Net/DNS/RR/TSIG.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/RR/TSIG.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::RR::TSIG; # -# $Id: TSIG.pm 1597 2017-09-22 08:04:02Z willem $ +# $Id: TSIG.pm 1718 2018-10-22 14:39:29Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1597 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1718 $)[1]; use strict; @@ -367,7 +367,7 @@ ); } - croak "Usage: create $class(keyfile)\n\tcreate $class(keyname, key)" + croak "Usage: create $class(keyfile)\n\tcreate $class(keyname, key)"; } elsif ( scalar(@_) == 1 ) { my $key = shift; # ( keyname, key ) @@ -388,7 +388,7 @@ } my ( $vol, $dir, $file ) = File::Spec->splitpath( $keyfile->name ); - croak "misnamed private key" unless $file =~ /^K([^+]+)+.+private$/; + croak 'misnamed private key' unless $file =~ /^K([^+]+)+.+private$/; my $kname = $1; return new Net::DNS::RR( name => $kname, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/RR.pm new/Net-DNS-1.19/lib/Net/DNS/RR.pm --- old/Net-DNS-1.18/lib/Net/DNS/RR.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/RR.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::RR; # -# $Id: RR.pm 1714 2018-09-21 14:14:55Z willem $ +# $Id: RR.pm 1718 2018-10-22 14:39:29Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1714 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1718 $)[1]; =head1 NAME @@ -752,7 +752,7 @@ no strict q/refs/; my ($method) = reverse split /::/, $AUTOLOAD; *{$AUTOLOAD} = sub {undef}; ## suppress repetition and deep recursion - croak "$self has no class method '$method'" unless $oref; + croak qq[$self has no class method "$method"] unless $oref; my $string = $self->string; my @object = grep defined($_), $oref, $oref->VERSION; @@ -760,7 +760,7 @@ eval("require $module") if $oref eq __PACKAGE__; @_ = ( <<"END", $@, "@object" ); -*** FATAL PROGRAM ERROR!! Unknown instance method '$method' +*** FATAL PROGRAM ERROR!! Unknown instance method "$method" *** which the program has attempted to call for the object: *** $string diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/Resolver/Base.pm new/Net-DNS-1.19/lib/Net/DNS/Resolver/Base.pm --- old/Net-DNS-1.18/lib/Net/DNS/Resolver/Base.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/Resolver/Base.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::Resolver::Base; # -# $Id: Base.pm 1709 2018-09-07 08:03:09Z willem $ +# $Id: Base.pm 1719 2018-11-04 05:01:43Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1709 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1719 $)[1]; # @@ -26,7 +26,7 @@ # [Revised March 2016, June 2018] -use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1;'; +use constant USE_SOCKET_IP => defined eval 'use IO::Socket::IP 0.32; 1'; use constant IPv6 => USE_SOCKET_IP; @@ -165,9 +165,9 @@ sub _read_env { ## read resolver config environment variables my $self = shift; - $self->nameservers( map split, $ENV{RES_NAMESERVERS} ) if defined $ENV{RES_NAMESERVERS}; + $self->searchlist( map split, $ENV{LOCALDOMAIN} ) if defined $ENV{LOCALDOMAIN}; - $self->domain( $ENV{LOCALDOMAIN} ) if defined $ENV{LOCALDOMAIN}; + $self->nameservers( map split, $ENV{RES_NAMESERVERS} ) if defined $ENV{RES_NAMESERVERS}; $self->searchlist( map split, $ENV{RES_SEARCHLIST} ) if defined $ENV{RES_SEARCHLIST}; @@ -181,14 +181,14 @@ my $self = shift; my $file = shift; - local *FILE; - open( FILE, $file ) or croak "$file: $!"; + my $filehandle; + open( $filehandle, '<', $file ) or croak "$file: $!"; my @nameserver; my @searchlist; local $_; - while (<FILE>) { + while (<$filehandle>) { s/[;#].*$//; # strip comments /^nameserver/ && do { @@ -217,7 +217,7 @@ }; } - close(FILE); + close($filehandle); $self->nameservers(@nameserver) if @nameserver; $self->searchlist(@searchlist) if @searchlist; @@ -363,11 +363,7 @@ my $self = shift; my $name = shift || '.'; - my @sfix; - - if ( $self->{defnames} && ( ( $name =~ tr/././ ) < $self->{ndots} ) ) { - @sfix = $self->domain unless $name =~ m/:|\.\d*$/; - } + my @sfix = $self->{defnames} && ( $name !~ m/[.:]/ ) ? $self->domain : (); my $fqdn = join '.', $name, @sfix; $self->_diag( 'query(', $fqdn, @_, ')' ); @@ -382,11 +378,12 @@ return $self->query(@_) unless $self->{dnsrch}; my $name = shift || '.'; + my $dots = $name =~ tr/././; - my @sfix = ( $name =~ m/:|\.\d*$/ ) ? () : @{$self->{searchlist}}; - my ( $domain, @etc ) = ( $name =~ tr/././ ) < $self->{ndots} ? (@sfix) : ( undef, @sfix ); + my @sfix = ( $dots < $self->{ndots} ) ? @{$self->{searchlist}} : (); + my ( $one, @more ) = ( $name =~ m/:|\.\d*$/ ) ? () : ( $dots ? ( undef, @sfix ) : @sfix ); - foreach my $suffix ( $domain, @etc ) { + foreach my $suffix ( $one, @more ) { my $fqname = $suffix ? join( '.', $name, $suffix ) : $name; $self->_diag( 'search(', $fqname, @_, ')' ); my $packet = $self->send( $fqname, @_ ) || next; @@ -402,6 +399,8 @@ my $packet = $self->_make_query_packet(@_); my $packet_data = $packet->data; + $self->_reset_errorstring; + return $self->_send_tcp( $packet, $packet_data ) if $self->{usevc} || length $packet_data > $self->_packetsz; @@ -418,8 +417,6 @@ sub _send_tcp { my ( $self, $query, $query_data ) = @_; - $self->_reset_errorstring; - my $tcp_packet = pack 'n a*', length($query_data), $query_data; my @ns = $self->nameservers(); my $fallback; @@ -465,8 +462,6 @@ sub _send_udp { my ( $self, $query, $query_data ) = @_; - $self->_reset_errorstring; - my @ns = $self->nameservers; my $port = $self->{port}; my $retrans = $self->{retrans} || 1; @@ -548,6 +543,8 @@ my $packet = $self->_make_query_packet(@_); my $packet_data = $packet->data; + $self->_reset_errorstring; + return $self->_bgsend_tcp( $packet, $packet_data ) if $self->{usevc} || length $packet_data > $self->_packetsz; @@ -558,8 +555,6 @@ sub _bgsend_tcp { my ( $self, $packet, $packet_data ) = @_; - $self->_reset_errorstring; - my $tcp_packet = pack 'n a*', length($packet_data), $packet_data; foreach my $ip ( $self->nameservers ) { @@ -583,8 +578,6 @@ sub _bgsend_udp { my ( $self, $packet, $packet_data ) = @_; - $self->_reset_errorstring; - my $port = $self->{port}; foreach my $ip ( $self->nameservers ) { @@ -685,9 +678,8 @@ my $header = $reply->header; return unless $header->qr; - return 1 unless $query; # SpamAssassin 3.4.1 workaround + return if $query && $header->id != $query->header->id; - return unless $header->id == $query->header->id; $self->errorstring( $header->rcode ); # historical quirk } @@ -1123,7 +1115,7 @@ my $name = $AUTOLOAD; $name =~ s/.*://; - croak "$name: no such method" unless $public_attr{$name}; + croak qq[unknown method "$name"] unless $public_attr{$name}; no strict q/refs/; *{$AUTOLOAD} = sub { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/Resolver/cygwin.pm new/Net-DNS-1.19/lib/Net/DNS/Resolver/cygwin.pm --- old/Net-DNS-1.18/lib/Net/DNS/Resolver/cygwin.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/Resolver/cygwin.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::Resolver::cygwin; # -# $Id: cygwin.pm 1568 2017-05-27 06:40:20Z willem $ +# $Id: cygwin.pm 1719 2018-11-04 05:01:43Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1568 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1719 $)[1]; =head1 NAME @@ -21,11 +21,11 @@ sub _getregkey { my $key = join '/', @_; - local *LM; - open( LM, "<$key" ) or return ''; - my $value = <LM>; + my $filehandle; + open( $filehandle, '<', $key ) or return ''; + my $value = <$filehandle>; $value =~ s/\0+$// if $value; - close(LM); + close($filehandle); return $value || ''; } @@ -34,7 +34,7 @@ sub _init { my $defaults = shift->_defaults; - local *LM; + my $dirhandle; my $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters'; @@ -75,9 +75,9 @@ my @nameservers; my $dnsadapters = join '/', $root, 'DNSRegisteredAdapters'; - if ( opendir( LM, $dnsadapters ) ) { - my @adapters = grep !/^\.\.?$/, readdir(LM); - closedir(LM); + if ( opendir( $dirhandle, $dnsadapters ) ) { + my @adapters = grep !/^\.\.?$/, readdir($dirhandle); + closedir($dirhandle); foreach my $adapter (@adapters) { my $ns = _getregkey( $dnsadapters, $adapter, 'DNSServerAddresses' ); until ( length($ns) < 4 ) { @@ -88,9 +88,9 @@ } my $interfaces = join '/', $root, 'Interfaces'; - if ( opendir( LM, $interfaces ) ) { - my @ifacelist = grep !/^\.\.?$/, readdir(LM); - closedir(LM); + if ( opendir( $dirhandle, $interfaces ) ) { + my @ifacelist = grep !/^\.\.?$/, readdir($dirhandle); + closedir($dirhandle); foreach my $iface (@ifacelist) { my $ip = _getregkey( $interfaces, $iface, 'DhcpIPAddress' ) || _getregkey( $interfaces, $iface, 'IPAddress' ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/Resolver/os390.pm new/Net-DNS-1.19/lib/Net/DNS/Resolver/os390.pm --- old/Net-DNS-1.18/lib/Net/DNS/Resolver/os390.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/Resolver/os390.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::Resolver::os390; # -# $Id: os390.pm 1579 2017-06-26 11:36:57Z willem $ +# $Id: os390.pm 1719 2018-11-04 05:01:43Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1579 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1719 $)[1]; =head1 NAME @@ -58,14 +58,14 @@ foreach my $dataset ( Net::DNS::Resolver::Base::_untaint( grep defined, @dataset ) ) { eval { - local *FILE; # "cat" able to read MVS dataset - open( FILE, qq[cat "$dataset" 2>/dev/null |] ) or die "$dataset: $!"; + my $filehandle; # "cat" able to read MVS dataset + open( $filehandle, '-|', qq[cat "$dataset" 2>/dev/null] ) or die "$dataset: $!"; my @nameserver; my @searchlist; local $_; - while (<FILE>) { + while (<$filehandle>) { s/[;#].*$//; # strip comment s/^\s+//; # strip leading white space next unless $_; # skip empty line @@ -122,7 +122,7 @@ }; } - close(FILE); + close($filehandle); $defaults->nameserver(@nameserver) if @nameserver && !$stop{nameserver}++; $defaults->searchlist(@searchlist) if @searchlist && !$stop{search}++; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS/Resolver.pm new/Net-DNS-1.19/lib/Net/DNS/Resolver.pm --- old/Net-DNS-1.18/lib/Net/DNS/Resolver.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS/Resolver.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,9 +1,9 @@ package Net::DNS::Resolver; # -# $Id: Resolver.pm 1714 2018-09-21 14:14:55Z willem $ +# $Id: Resolver.pm 1717 2018-10-12 13:14:42Z willem $ # -our $VERSION = (qw$LastChangedRevision: 1714 $)[1]; +our $VERSION = (qw$LastChangedRevision: 1717 $)[1]; =head1 NAME @@ -158,8 +158,7 @@ $packet = $resolver->query( 'annotation.example.com', 'TXT', 'IN' ); Performs a DNS query for the given name; the search list is not applied. -If C<defnames> is true, and the number of dots is less than C<ndots>, -the default domain will be appended unless name is absolute. +If C<defnames> is true, the default domain will be appended to unqualified names. The record type and class can be omitted; they default to A and IN. If the name looks like an IP address (IPv4 or IPv6), @@ -183,10 +182,10 @@ Performs a DNS query for the given name, applying the searchlist if appropriate. The search algorithm is as follows: -Unless the number of dots is less than C<ndots>, +If the name contains one or more non-terminal dots, perform an initial query using the unmodified name. -If C<dnsrch> is true and the name has no terminal dot, +If the number of dots is less than C<ndots>, and there is no terminal dot, try appending each suffix in the search list. The record type and class can be omitted; they default to A and IN. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/lib/Net/DNS.pm new/Net-DNS-1.19/lib/Net/DNS.pm --- old/Net-DNS-1.18/lib/Net/DNS.pm 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/lib/Net/DNS.pm 2018-11-14 16:46:06.000000000 +0100 @@ -1,13 +1,13 @@ package Net::DNS; # -# $Id: DNS.pm 1715 2018-09-21 14:17:46Z willem $ +# $Id: DNS.pm 1722 2018-11-14 15:45:37Z willem $ # require 5.006; our $VERSION; -$VERSION = '1.18'; +$VERSION = '1.19'; $VERSION = eval $VERSION; -our $SVNVERSION = (qw$LastChangedRevision: 1715 $)[1]; +our $SVNVERSION = (qw$LastChangedRevision: 1722 $)[1]; =head1 NAME diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/t/05-OPT.t new/Net-DNS-1.19/t/05-OPT.t --- old/Net-DNS-1.18/t/05-OPT.t 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/t/05-OPT.t 2018-11-14 16:46:06.000000000 +0100 @@ -1,4 +1,4 @@ -# $Id: 05-OPT.t 1543 2017-02-28 19:27:23Z willem $ -*-perl-*- +# $Id: 05-OPT.t 1717 2018-10-12 13:14:42Z willem $ -*-perl-*- use strict; use Test::More; @@ -166,7 +166,7 @@ $edns->option( CHAIN => ( 'TRUST-POINT' => '' ) ); - is( length( $edns->option(13) ), 0, "option CHAIN => ''" ); + is( length( $edns->option(13) ), 1, "option CHAIN => ''" ); my $option13 = $edns->option( CHAIN => ( 'TRUST-POINT' => 'com.' ) ); is( scalar( $edns->option(13) ), $option13, "option CHAIN => ('TRUST-POINT' => 'com.')" ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/t/08-IPv4.t new/Net-DNS-1.19/t/08-IPv4.t --- old/Net-DNS-1.18/t/08-IPv4.t 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/t/08-IPv4.t 2018-11-14 16:46:06.000000000 +0100 @@ -1,4 +1,4 @@ -# $Id: 08-IPv4.t 1709 2018-09-07 08:03:09Z willem $ -*-perl-*- +# $Id: 08-IPv4.t 1719 2018-11-04 05:01:43Z willem $ -*-perl-*- use strict; use Test::More; @@ -71,21 +71,54 @@ Net::DNS::Resolver->debug($debug); -plan tests => 94; +plan tests => 91; NonFatalBegin(); { + my $resolver = Net::DNS::Resolver->new( defnames => 1, ndots => 1 ); + my @query = (qw(. SOA IN)); + + ok( $resolver->query( undef, qw(SOA IN) ), '$resolver->query( undef, ... ) defaults to "."' ); + + $resolver->defnames(0); + ok( $resolver->query(@query), '$resolver->query() without defnames' ); +} + + +{ + my $resolver = Net::DNS::Resolver->new( dnsrch => 1, ndots => 1 ); + my @query = (qw(. SOA IN)); + + ok( $resolver->search( undef, qw(SOA IN) ), '$resolver->search( undef, ... ) defaults to "."' ); + + $resolver->ndots(2); + ok( $resolver->search(@query), '$resolver->search() with ndots > 1' ); + + $resolver->dnsrch(0); + ok( $resolver->search(@query), '$resolver->search() without dnsrch' ); +} + + +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $IP, dnsrch => 1, ndots => 2 ); + $resolver->searchlist(qw(nx.net-dns.org net-dns.org)); + + ok( $resolver->search('ns'), '$resolver->search( simple name, ... )' ); + ok( $resolver->search('net-dns.org'), '$resolver->search( dotted name, ... )' ); +} + + +{ my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - my $udp = $resolver->send(qw(net-dns.org SOA IN)); - ok( $udp, '$resolver->send(...) UDP' ); + my $packet = new Net::DNS::Packet(qw(net-dns.org SOA IN)); + ok( $resolver->send($packet), '$resolver->send(...) UDP' ); - $resolver->usevc(1); + $packet->edns->option( PADDING => ( 'OPTION-LENGTH' => 500 ) ); # force TCP - my $tcp = $resolver->send(qw(net-dns.org SOA IN)); - ok( $tcp, '$resolver->send(...) TCP' ); + ok( $resolver->send($packet), '$resolver->send(...) TCP' ); } @@ -108,24 +141,20 @@ my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(0); - my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); + my $packet = new Net::DNS::Packet(qw(net-dns.org SOA IN)); + + my $udp = $resolver->bgsend($packet); ok( $udp, '$resolver->bgsend(...) UDP' ); while ( $resolver->bgbusy($udp) ) { sleep 1; } ok( $resolver->bgisready($udp), '$resolver->bgisready($udp)' ); ok( $resolver->bgread($udp), '$resolver->bgread($udp)' ); - $resolver->usevc(1); + $packet->edns->option( PADDING => ( 'OPTION-LENGTH' => 500 ) ); # force TCP - my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); + my $tcp = $resolver->bgsend($packet); ok( $tcp, '$resolver->bgsend(...) TCP' ); while ( $resolver->bgbusy($tcp) ) { sleep 1; } ok( $resolver->bgread($tcp), '$resolver->bgread($tcp)' ); - - ok( !$resolver->bgbusy(undef), '!$resolver->bgbusy(undef)' ); - ok( !$resolver->bgread(undef), '!$resolver->bgread(undef)' ); - - $resolver->udp_timeout(0); - ok( !$resolver->bgread( ref($udp)->new ), '!$resolver->bgread(Socket->new)' ); } @@ -163,6 +192,7 @@ my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); $resolver->nameserver($NOIP); + $resolver->srcport(-1); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) background TCP fail' ); } @@ -170,16 +200,6 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - - my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); - delete ${*$handle}{net_dns_bg}; - my $bgread = $resolver->bgread($handle); - ok( $bgread, '$resolver->bgread($udp) workaround for SpamAssassin' ); -} - - -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->persistent_udp(1); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); @@ -238,36 +258,6 @@ } -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - my $badport = -1; - $resolver->srcport($badport); - - my $udp = $resolver->send(qw(net-dns.org SOA IN)); - ok( !$udp, "\$resolver->send(...) reject UDP source port $badport" ); - - $resolver->usevc(1); - - my $tcp = $resolver->send(qw(net-dns.org SOA IN)); - ok( !$tcp, "\$resolver->send(...) reject TCP source port $badport" ); -} - - -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - my $badport = -1; - $resolver->srcport($badport); - - my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); - ok( !$udp, "\$resolver->bgsend(...) reject UDP source port $badport" ); - - $resolver->usevc(1); - - my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); - ok( !$tcp, "\$resolver->bgsend(...) reject TCP source port $badport" ); -} - - SKIP: { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); @@ -316,38 +306,6 @@ { - my $resolver = Net::DNS::Resolver->new(); - $resolver->retrans(0); - $resolver->retry(0); - - my @query = ( undef, qw(SOA IN) ); - ok( $resolver->query(@query), '$resolver->query( undef, ... ) defaults to "." ' ); - ok( $resolver->search(@query), '$resolver->search( undef, ... ) defaults to "." ' ); - - $resolver->defnames(0); - $resolver->dnsrch(0); - ok( $resolver->search(@query), '$resolver->search() without dnsrch & defnames' ); -} - - -{ - my $resolver = Net::DNS::Resolver->new(); - my @query = (qw(us SOA IN)); - - $resolver->searchlist('net'); - ok( $resolver->query(@query), '$resolver->query( name, ... )' ); - - $resolver->searchlist('example.com', 'net'); - ok( $resolver->search(@query), '$resolver->search( name, ... )' ); - - $resolver->defnames(0); - $resolver->dnsrch(0); - ok( $resolver->query(@query), '$resolver->query() without defnames' ); - ok( $resolver->search(@query), '$resolver->search() without dnsrch' ); -} - - -{ my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $udp = $resolver->query(qw(bogus.net-dns.org A IN)); @@ -373,16 +331,23 @@ my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP ); $resolver->retrans(0); $resolver->retry(0); - $resolver->tcp_timeout(0); my @query = (qw(:: SOA IN)); - my $query = new Net::DNS::Packet(@query); ok( !$resolver->query(@query), '$resolver->query() failure' ); ok( !$resolver->search(@query), '$resolver->search() failure' ); +} + - $query->edns->option( 65001, pack 'x500' ); # pad to force TCP - ok( !$resolver->send($query), '$resolver->send() failure' ); - ok( !$resolver->bgsend($query), '$resolver->bgsend() failure' ); +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP, srcport => -1 ); + $resolver->tcp_timeout(0); + + my $query = new Net::DNS::Packet(qw(:: SOA IN)); + ok( !$resolver->send($query), '$resolver->send() no UDP socket' ); + ok( !$resolver->bgsend($query), '$resolver->bgsend() no UDP socket' ); + $resolver->usevc(1); + ok( !$resolver->send($query), '$resolver->send() no TCP socket' ); + ok( !$resolver->bgsend($query), '$resolver->bgsend() no TCP socket' ); } @@ -446,11 +411,14 @@ my $axfr_start = $resolver->axfr_start('net-dns.org'); ok( $axfr_start, '$resolver->axfr_start() (historical)' ); ok( eval { $resolver->axfr_next() }, '$resolver->axfr_next() (historical)' ); +} - $resolver->srcport(-1); - my @badsocket = $resolver->axfr(); - my $badsocket = $resolver->errorstring; - ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" ); + +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP, srcport => -1 ); + my @nosocket = $resolver->axfr(); + my $nosocket = $resolver->errorstring; + ok( !scalar(@nosocket), "no AXFR socket\t[$nosocket]" ); } @@ -556,20 +524,13 @@ } -{ ## exercise error paths in _send_???() and bgbusy() +{ ## exercise error paths in _send_???() my $resolver = Net::DNS::Resolver->new( nameservers => $IP, retry => 1 ); my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); my $mismatch = $resolver->_make_query_packet(qw(net-dns.org SOA)); ok( !$resolver->_send_tcp( $mismatch, $packet->data ), '_send_tcp() id mismatch' ); ok( !$resolver->_send_udp( $mismatch, $packet->data ), '_send_udp() id mismatch' ); - my $handle = $resolver->_bgsend_udp( $mismatch, $packet->data ); - ok( !$resolver->bgread($handle), 'bgbusy() id mismatch' ); -} - - -{ ## exercise error path in _cname_addr() - is( scalar( Net::DNS::Resolver::Base::_cname_addr( undef, undef ) ), 0, '_cname_addr() no reply packet' ); } @@ -580,7 +541,7 @@ my $reply = new Net::DNS::Packet(qw(net-dns.org SOA IN)); $reply->header->qr(1); - ok( !$resolver->_accept_reply(undef), '_accept_reply() corrupt reply' ); + ok( !$resolver->_accept_reply(undef), '_accept_reply() no reply' ); ok( !$resolver->_accept_reply($query), '_accept_reply() qr not set' ); @@ -588,6 +549,29 @@ } +{ ## exercise error path in bgbusy() and _bgread() + my $resolver = Net::DNS::Resolver->new( nameservers => $IP, udp_timeout => 0 ); + + ok( !$resolver->bgread(undef), '_bgread() undefined handle' ); + + my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); + my $second = $resolver->_make_query_packet(qw(net-dns.org SOA)); + my $handle = $resolver->_bgsend_udp( $packet, $second->data ); + ok( !$resolver->bgread($handle), '_bgbusy() no reply' ); + + my $socket = $resolver->bgsend($packet); + delete ${*$socket}{net_dns_bg}; + ok( $resolver->bgread($socket), '_bgbusy() SpamAssassin workaround' ); + + ok( !$resolver->bgread( ref($socket)->new ), '_bgread() timeout' ); +} + + +{ ## exercise error path in _cname_addr() + is( scalar( Net::DNS::Resolver::Base::_cname_addr( undef, undef ) ), 0, '_cname_addr() no reply packet' ); +} + + { ## exercise error path in _read_tcp() my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->tcp_timeout(10); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/t/08-IPv6.t new/Net-DNS-1.19/t/08-IPv6.t --- old/Net-DNS-1.18/t/08-IPv6.t 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/t/08-IPv6.t 2018-11-14 16:46:06.000000000 +0100 @@ -1,4 +1,4 @@ -# $Id: 08-IPv6.t 1709 2018-09-07 08:03:09Z willem $ -*-perl-*- +# $Id: 08-IPv6.t 1719 2018-11-04 05:01:43Z willem $ -*-perl-*- use strict; use Test::More; @@ -74,21 +74,54 @@ Net::DNS::Resolver->debug($debug); -plan tests => 94; +plan tests => 91; NonFatalBegin(); { + my $resolver = Net::DNS::Resolver->new( defnames => 1, ndots => 1 ); + my @query = (qw(. SOA IN)); + + ok( $resolver->query( undef, qw(SOA IN) ), '$resolver->query( undef, ... ) defaults to "."' ); + + $resolver->defnames(0); + ok( $resolver->query(@query), '$resolver->query() without defnames' ); +} + + +{ + my $resolver = Net::DNS::Resolver->new( dnsrch => 1, ndots => 1 ); + my @query = (qw(. SOA IN)); + + ok( $resolver->search( undef, qw(SOA IN) ), '$resolver->search( undef, ... ) defaults to "."' ); + + $resolver->ndots(2); + ok( $resolver->search(@query), '$resolver->search() with ndots > 1' ); + + $resolver->dnsrch(0); + ok( $resolver->search(@query), '$resolver->search() without dnsrch' ); +} + + +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $IP, dnsrch => 1, ndots => 2 ); + $resolver->searchlist(qw(nx.net-dns.org net-dns.org)); + + ok( $resolver->search('ns'), '$resolver->search( simple name, ... )' ); + ok( $resolver->search('net-dns.org'), '$resolver->search( dotted name, ... )' ); +} + + +{ my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - my $udp = $resolver->send(qw(net-dns.org SOA IN)); - ok( $udp, '$resolver->send(...) UDP' ); + my $packet = new Net::DNS::Packet(qw(net-dns.org SOA IN)); + ok( $resolver->send($packet), '$resolver->send(...) UDP' ); - $resolver->usevc(1); + $packet->edns->option( PADDING => ( 'OPTION-LENGTH' => 500 ) ); # force TCP - my $tcp = $resolver->send(qw(net-dns.org SOA IN)); - ok( $tcp, '$resolver->send(...) TCP' ); + ok( $resolver->send($packet), '$resolver->send(...) TCP' ); } @@ -111,24 +144,20 @@ my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(0); - my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); + my $packet = new Net::DNS::Packet(qw(net-dns.org SOA IN)); + + my $udp = $resolver->bgsend($packet); ok( $udp, '$resolver->bgsend(...) UDP' ); while ( $resolver->bgbusy($udp) ) { sleep 1; } ok( $resolver->bgisready($udp), '$resolver->bgisready($udp)' ); ok( $resolver->bgread($udp), '$resolver->bgread($udp)' ); - $resolver->usevc(1); + $packet->edns->option( PADDING => ( 'OPTION-LENGTH' => 500 ) ); # force TCP - my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); + my $tcp = $resolver->bgsend($packet); ok( $tcp, '$resolver->bgsend(...) TCP' ); while ( $resolver->bgbusy($tcp) ) { sleep 1; } ok( $resolver->bgread($tcp), '$resolver->bgread($tcp)' ); - - ok( !$resolver->bgbusy(undef), '!$resolver->bgbusy(undef)' ); - ok( !$resolver->bgread(undef), '!$resolver->bgread(undef)' ); - - $resolver->udp_timeout(0); - ok( !$resolver->bgread( ref($udp)->new ), '!$resolver->bgread(Socket->new)' ); } @@ -166,6 +195,7 @@ my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); $resolver->nameserver($NOIP); + $resolver->srcport(-1); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) background TCP fail' ); } @@ -173,16 +203,6 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - - my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); - delete ${*$handle}{net_dns_bg}; - my $bgread = $resolver->bgread($handle); - ok( $bgread, '$resolver->bgread($udp) workaround for SpamAssassin' ); -} - - -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->persistent_udp(1); my $handle = $resolver->bgsend(qw(net-dns.org SOA IN)); @@ -241,36 +261,6 @@ } -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - my $badport = -1; - $resolver->srcport($badport); - - my $udp = $resolver->send(qw(net-dns.org SOA IN)); - ok( !$udp, "\$resolver->send(...) reject UDP source port $badport" ); - - $resolver->usevc(1); - - my $tcp = $resolver->send(qw(net-dns.org SOA IN)); - ok( !$tcp, "\$resolver->send(...) reject TCP source port $badport" ); -} - - -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - my $badport = -1; - $resolver->srcport($badport); - - my $udp = $resolver->bgsend(qw(net-dns.org SOA IN)); - ok( !$udp, "\$resolver->bgsend(...) reject UDP source port $badport" ); - - $resolver->usevc(1); - - my $tcp = $resolver->bgsend(qw(net-dns.org SOA IN)); - ok( !$tcp, "\$resolver->bgsend(...) reject TCP source port $badport" ); -} - - SKIP: { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->domain('net-dns.org'); @@ -319,38 +309,6 @@ { - my $resolver = Net::DNS::Resolver->new(); - $resolver->retrans(0); - $resolver->retry(0); - - my @query = ( undef, qw(SOA IN) ); - ok( $resolver->query(@query), '$resolver->query( undef, ... ) defaults to "." ' ); - ok( $resolver->search(@query), '$resolver->search( undef, ... ) defaults to "." ' ); - - $resolver->defnames(0); - $resolver->dnsrch(0); - ok( $resolver->search(@query), '$resolver->search() without dnsrch & defnames' ); -} - - -{ - my $resolver = Net::DNS::Resolver->new(); - my @query = (qw(us SOA IN)); - - $resolver->searchlist('net'); - ok( $resolver->query(@query), '$resolver->query( name, ... )' ); - - $resolver->searchlist('example.com', 'net'); - ok( $resolver->search(@query), '$resolver->search( name, ... )' ); - - $resolver->defnames(0); - $resolver->dnsrch(0); - ok( $resolver->query(@query), '$resolver->query() without defnames' ); - ok( $resolver->search(@query), '$resolver->search() without dnsrch' ); -} - - -{ my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); my $udp = $resolver->query(qw(bogus.net-dns.org A IN)); @@ -376,16 +334,23 @@ my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP ); $resolver->retrans(0); $resolver->retry(0); - $resolver->tcp_timeout(0); my @query = (qw(:: SOA IN)); - my $query = new Net::DNS::Packet(@query); ok( !$resolver->query(@query), '$resolver->query() failure' ); ok( !$resolver->search(@query), '$resolver->search() failure' ); +} + - $query->edns->option( 65001, pack 'x500' ); # pad to force TCP - ok( !$resolver->send($query), '$resolver->send() failure' ); - ok( !$resolver->bgsend($query), '$resolver->bgsend() failure' ); +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP, srcport => -1 ); + $resolver->tcp_timeout(0); + + my $query = new Net::DNS::Packet(qw(:: SOA IN)); + ok( !$resolver->send($query), '$resolver->send() no UDP socket' ); + ok( !$resolver->bgsend($query), '$resolver->bgsend() no UDP socket' ); + $resolver->usevc(1); + ok( !$resolver->send($query), '$resolver->send() no TCP socket' ); + ok( !$resolver->bgsend($query), '$resolver->bgsend() no TCP socket' ); } @@ -449,11 +414,14 @@ my $axfr_start = $resolver->axfr_start('net-dns.org'); ok( $axfr_start, '$resolver->axfr_start() (historical)' ); ok( eval { $resolver->axfr_next() }, '$resolver->axfr_next() (historical)' ); +} - $resolver->srcport(-1); - my @badsocket = $resolver->axfr(); - my $badsocket = $resolver->errorstring; - ok( !scalar(@badsocket), "bad AXFR socket\t[$badsocket]" ); + +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $NOIP, srcport => -1 ); + my @nosocket = $resolver->axfr(); + my $nosocket = $resolver->errorstring; + ok( !scalar(@nosocket), "no AXFR socket\t[$nosocket]" ); } @@ -559,20 +527,13 @@ } -{ ## exercise error paths in _send_???() and bgbusy() +{ ## exercise error paths in _send_???() my $resolver = Net::DNS::Resolver->new( nameservers => $IP, retry => 1 ); my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); my $mismatch = $resolver->_make_query_packet(qw(net-dns.org SOA)); ok( !$resolver->_send_tcp( $mismatch, $packet->data ), '_send_tcp() id mismatch' ); ok( !$resolver->_send_udp( $mismatch, $packet->data ), '_send_udp() id mismatch' ); - my $handle = $resolver->_bgsend_udp( $mismatch, $packet->data ); - ok( !$resolver->bgread($handle), 'bgbusy() id mismatch' ); -} - - -{ ## exercise error path in _cname_addr() - is( scalar( Net::DNS::Resolver::Base::_cname_addr( undef, undef ) ), 0, '_cname_addr() no reply packet' ); } @@ -583,7 +544,7 @@ my $reply = new Net::DNS::Packet(qw(net-dns.org SOA IN)); $reply->header->qr(1); - ok( !$resolver->_accept_reply(undef), '_accept_reply() corrupt reply' ); + ok( !$resolver->_accept_reply(undef), '_accept_reply() no reply' ); ok( !$resolver->_accept_reply($query), '_accept_reply() qr not set' ); @@ -591,6 +552,29 @@ } +{ ## exercise error path in bgbusy() and _bgread() + my $resolver = Net::DNS::Resolver->new( nameservers => $IP, udp_timeout => 0 ); + + ok( !$resolver->bgread(undef), '_bgread() undefined handle' ); + + my $packet = $resolver->_make_query_packet(qw(net-dns.org SOA)); + my $second = $resolver->_make_query_packet(qw(net-dns.org SOA)); + my $handle = $resolver->_bgsend_udp( $packet, $second->data ); + ok( !$resolver->bgread($handle), '_bgbusy() no reply' ); + + my $socket = $resolver->bgsend($packet); + delete ${*$socket}{net_dns_bg}; + ok( $resolver->bgread($socket), '_bgbusy() SpamAssassin workaround' ); + + ok( !$resolver->bgread( ref($socket)->new ), '_bgread() timeout' ); +} + + +{ ## exercise error path in _cname_addr() + is( scalar( Net::DNS::Resolver::Base::_cname_addr( undef, undef ) ), 0, '_cname_addr() no reply packet' ); +} + + { ## exercise error path in _read_tcp() my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->tcp_timeout(10); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.18/t/08-recurse.t new/Net-DNS-1.19/t/08-recurse.t --- old/Net-DNS-1.18/t/08-recurse.t 2018-09-21 16:18:06.000000000 +0200 +++ new/Net-DNS-1.19/t/08-recurse.t 2018-11-14 16:46:06.000000000 +0100 @@ -1,4 +1,4 @@ -# $Id: 08-recurse.t 1709 2018-09-07 08:03:09Z willem $ -*-perl-*- +# $Id: 08-recurse.t 1719 2018-11-04 05:01:43Z willem $ -*-perl-*- use strict; use Test::More; @@ -11,6 +11,10 @@ use Net::DNS; use Net::DNS::Resolver::Recurse; +my @hints = new Net::DNS::Resolver()->_hints; + +my @NOIP = qw(:: 0.0.0.0); + exit( plan skip_all => 'Online tests disabled.' ) if -e 't/online.disabled'; exit( plan skip_all => 'Online tests disabled.' ) unless -e 't/online.enabled'; @@ -30,8 +34,8 @@ eval { - my $resolver = new Net::DNS::Resolver::Recurse(); - exit plan skip_all => "No nameservers" unless $resolver->nameservers; + my $resolver = new Net::DNS::Resolver( nameservers => [@hints] ); + exit plan skip_all => 'No nameservers' unless $resolver->nameservers; my $reply = $resolver->send(qw(. NS IN)) || die; my $from = $reply->from(); @@ -45,7 +49,7 @@ } || exit( plan skip_all => 'Unable to reach global root nameservers' ); -plan 'no_plan'; +plan tests => 13; NonFatalBegin(); @@ -55,9 +59,10 @@ ok( $res->isa('Net::DNS::Resolver::Recurse'), 'new() created object' ); - my $packet = $res->query_dorecursion( 'www.net-dns.org', 'A' ); - ok( $packet, 'got a packet' ); - ok( scalar $packet->answer, 'answer section has RRs' ) if $packet; + my $reply = $res->query_dorecursion( 'www.net-dns.org', 'A' ); + is( ref($reply), 'Net::DNS::Packet', 'query returned a packet' ); + skip( 'no response to query', 1 ) unless $reply; + ok( scalar( $reply->answer ), 'answer section has RRs' ); } @@ -67,11 +72,7 @@ my $count = 0; - $res->recursion_callback( - sub { - ok( shift->isa('Net::DNS::Packet'), 'callback argument is a packet' ); - $count++; - } ); + $res->recursion_callback( sub { $count++ if ref(shift) } ); $res->query_dorecursion( 'a.t.net-dns.org', 'A' ); @@ -84,10 +85,7 @@ my $count = 0; - $res->recursion_callback( - sub { - $count++; - } ); + $res->recursion_callback( sub { $count++ if ref(shift) } ); $res->query_dorecursion( '2a04:b900:0:0:8:0:0:60', 'PTR' ); @@ -96,14 +94,13 @@ SKIP: { - my @hints = new Net::DNS::Resolver::Recurse()->_hints; my $res = Net::DNS::Resolver::Recurse->new(); - is( scalar( $res->hints() ), 0, "hints() initially empty" ); + is( scalar( $res->hints() ), 0, 'hints() initially empty' ); $res->hints(@hints); - is( scalar( $res->hints ), scalar(@hints), "hints() set" ); + is( scalar( $res->hints ), scalar(@hints), 'hints() set' ); - my $reply = $res->send( ".", "NS" ); - ok( $reply, 'got response to priming query' ); + my $reply = $res->send( '.', 'NS' ); + is( ref($reply), 'Net::DNS::Packet', 'response received for priming query' ); skip( 'no response to priming query', 3 ) unless $reply; my $from = $reply->from(); @@ -118,21 +115,18 @@ { - my $res = Net::DNS::Resolver::Recurse->new(); - $res->retrans(0); - $res->retry(0); - $res->srcport(-1); + my $res = Net::DNS::Resolver::Recurse->new( nameserver => [@NOIP], srcport => -1 ); - ok( !$res->send( "www.net-dns.org", "A" ), 'fail if no reachable server' ); + ok( !$res->send( 'www.net-dns.org', 'A' ), 'fail if no reachable server' ); } { - Net::DNS::Resolver->retry(0); + Net::DNS::Resolver::Recurse->retry(0); my $res = Net::DNS::Resolver::Recurse->new(); - $res->hints( '0.0.0.0', '::' ); + $res->hints(@NOIP); - ok( !$res->send( "www.net-dns.org", "A" ), 'fail if no usable hint' ); + ok( !$res->send( 'www.net-dns.org', 'A' ), 'fail if no usable hint' ); }
