![](https://seccdn.libravatar.org/avatar/af22e20b6884acbc89be6d7736c43e92.jpg?s=120&d=mm&r=g)
Hello community, here is the log from the commit of package perl-Net-DNS checked in at Wed Sep 20 16:43:09 CEST 2006. -------- --- perl-Net-DNS/perl-Net-DNS.changes 2006-07-13 12:47:06.000000000 +0200 +++ perl-Net-DNS/perl-Net-DNS.changes 2006-09-19 13:43:29.000000000 +0200 @@ -1,0 +2,7 @@ +Tue Sep 19 13:37:38 CEST 2006 - anicka@suse.cz + +- update to 0.59 + * proper reverse mapping of IPv6 addresses + * bugfixes + +------------------------------------------------------------------- Old: ---- Net-DNS-0.58.tar.bz2 New: ---- Net-DNS-0.59.tar.bz2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Net-DNS.spec ++++++ --- /var/tmp/diff_new_pack.jV5SVv/_old 2006-09-20 16:43:01.000000000 +0200 +++ /var/tmp/diff_new_pack.jV5SVv/_new 2006-09-20 16:43:01.000000000 +0200 @@ -1,5 +1,5 @@ # -# spec file for package perl-Net-DNS (Version 0.58) +# spec file for package perl-Net-DNS (Version 0.59) # # Copyright (c) 2006 SUSE LINUX Products GmbH, Nuernberg, Germany. # This file and all modifications and additions to the pristine @@ -12,7 +12,7 @@ Name: perl-Net-DNS BuildRequires: perl-Digest-HMAC perl-Net-IP -Version: 0.58 +Version: 0.59 Release: 1 Provides: perl_dns Obsoletes: perl_dns @@ -63,6 +63,10 @@ /var/adm/perl-modules/%{name} %changelog -n perl-Net-DNS +* Tue Sep 19 2006 - anicka@suse.cz +- update to 0.59 + * proper reverse mapping of IPv6 addresses + * bugfixes * Thu Jul 13 2006 - anicka@suse.cz - update to 0.58 * added hooks for DLV support in Net::DNS::SEC ++++++ Net-DNS-0.58.tar.bz2 -> Net-DNS-0.59.tar.bz2 ++++++ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/Changes new/Net-DNS-0.59/Changes --- old/Net-DNS-0.58/Changes 2006-07-04 10:06:26.000000000 +0200 +++ new/Net-DNS-0.59/Changes 2006-09-18 21:22:12.000000000 +0200 @@ -2,6 +2,44 @@ Revision history for Net::DNS -*-text-*- ============================= +*** 0.59 September 18, 2006 + + + +Fix rt.cpan.org 20836, 20857, 20994, and 21402 + + These tickets all revolved around proper reverse mapping of IPv6 + addresses. + + Acknowledgements to Dick Franks who has provided elegant solutions and + cleaned a bit of code. + + Note that directly calling Question->new() withouth arguments will + cause the qclass,qtype to be IN, A instead of ANY, ANY. + + Net::DNS::Resolver's search() method would always gracefully + interpret a qname in the form of an IPv4 address. It would go out + and do a PTR query in the reverse address tree. This behavior has + also been applied to IPv6 addresses in their many shapes and + forms. + + This change did two things, 1) root zone not implicitly added to + search list when looking up short name, 2) default domain appended + to short name if DEFNAMES and not DNSRCH. + + +Fix rt.cpan.org 18113 + + Minor error due to unapplied part of patch fixed. + +Feature: Experimental NSEC3 hooks. + + Added hook for future support of (experimental) NSEC3 suppport + (NSEC3 having an experimental type code). + + + + *** 0.58 July 4, 2006 Feature: hooks for DLV support in Net::DNS::SEC @@ -1156,4 +1194,4 @@ Chris Reinhardt Michael Fuhr -$Id: Changes 596 2006-07-04 07:42:36Z olaf $ +$Id: Changes 609 2006-09-18 10:48:22Z olaf $ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/META.yml new/Net-DNS-0.59/META.yml --- old/Net-DNS-0.58/META.yml 2006-07-04 10:06:45.000000000 +0200 +++ new/Net-DNS-0.59/META.yml 2006-09-18 21:23:00.000000000 +0200 @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Net-DNS -version: 0.58 +version: 0.59 version_from: lib/Net/DNS.pm installdirs: site requires: @@ -13,5 +13,4 @@ Test::More: 0.18 distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 -license: perl +generated_by: ExtUtils::MakeMaker version 6.30 diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/contrib/README new/Net-DNS-0.59/contrib/README --- old/Net-DNS-0.58/contrib/README 2006-07-04 10:06:23.000000000 +0200 +++ new/Net-DNS-0.59/contrib/README 2006-09-18 21:22:08.000000000 +0200 @@ -6,9 +6,6 @@ File Contributor ------ ----------- check_soa Dick Franks <rwfranks@acm.org> - A 'parallel implementation' of the - check_soa script in the examples - directory check_zone Dennis Glatting <dennis.glatting@software-munitions.com> @@ -19,4 +16,4 @@ loclist.pl Christopher Davis <ckd@kei.com> --- -$Id: README 586 2006-05-03 15:14:40Z olaf $ +$Id: README 607 2006-09-17 18:20:28Z olaf $ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/contrib/check_soa new/Net-DNS-0.59/contrib/check_soa --- old/Net-DNS-0.58/contrib/check_soa 2006-07-04 10:06:23.000000000 +0200 +++ new/Net-DNS-0.59/contrib/check_soa 2006-09-18 21:22:08.000000000 +0200 @@ -1,9 +1,9 @@ #!/usr/local/bin/perl -w -my $VERSION = 'Version 0.10'; +$main::VERSION = '0.16'; # =head1 NAME -B<check_soa> - Check nameservers for a domain +B<check_soa> - Check nameservers for a domain in parallel =head1 SYNOPSIS @@ -11,15 +11,17 @@ =head1 DESCRIPTION -Each nameserver for the specified domain name -is queried for the relevant SOA record and -the zone serial number printed. +Each nameserver for the specified domain is queried for the relevant SOA record +and the zone serial number printed. -Error reports are generated for servers tendering -non-authoritative, outdated or incorrect information. +Error reports are generated for nameservers which reply with non-authoritative, +outdated or incorrect information. -This program is a parallel implementation of -the check_soa idea described by Albitz and Liu. +SOA query packets are sent to the nameservers as rapidly as the underlying +hardware will allow. The program waits for a response only when it is needed +for analysis. Execution time is determined by the slowest nameserver. + +This program is based on the check_soa idea described by Albitz and Liu. =head1 OPTIONS AND ARGUMENTS @@ -54,22 +56,26 @@ =head1 COPYRIGHT -Copyright (c) 2003-2005, Dick Franks E<lt>rwfranks@acm.orgE<gt> +Copyright (c) 2003-2006, Dick Franks E<lt>rwfranks@acm.orgE<gt> This program is free software; you may use or redistribute it under the same terms as Perl itself. =head1 SEE ALSO -Paul Albitz and Cricket Liu. -DNS and BIND, 4th Edition. -O'Reilly & Associates, 2001. +Paul Albitz, Cricket Liu. +DNS and BIND, 5th Edition. +O'Reilly & Associates, 2006. M. Andrews. Negative Caching of DNS Queries. RFC2308, IETF Network Working Group, 1998. -R. Elz and R. Bush. +Tom Christiansen, Jon Orwant, Larry Wall. +Programming Perl, 3rd Edition. +O'Reilly & Associates, 2000. + +R. Elz, R. Bush. Clarifications to the DNS Specification. RFC2181, IETF Network Working Group, 1997. @@ -77,29 +83,26 @@ Domain Names - Concepts and Facilities. RFC1034, IETF Network Working Group, 1987. -Larry Wall, Tom Christiansen and Jon Orwant. -Programming Perl, 3rd Edition. -O'Reilly & Associates, 2000. - =cut use strict; use Getopt::Std; my $self = $0; # script +my $version = $main::VERSION; my %option; my $options = 'dtv'; # options -getopts("$options", \%option); +getopts("$options", \%option); # also --help --version my ($domain, @server) = @ARGV; # arguments -my $synopsis = "Usage:\t$self [-$options] domain [server]\t\t# $VERSION"; -die eval{ system("perldoc $self"); "" }, "\n$synopsis\n\n" unless @ARGV; +my $synopsis = "Synopsis:\t$self [-$options] domain [server]"; +die eval{ system("perldoc -F $self"); "" }, "\n$synopsis\n\n" unless @ARGV; require Net::DNS; -my @conf = ( debug => ($option{'d'} ? 1 : 0), # -d enable diagnostics - igntc => ($option{'t'} ? 1 : 0), # -t ignore truncation +my @conf = ( debug => ($option{'d'} || 0), # -d enable diagnostics + igntc => ($option{'t'} || 0), # -t ignore truncation recurse => 0, retry => 2 ); @@ -109,37 +112,42 @@ my $udp_wait = 0.010; # minimum polling interval -my $resolver = Net::DNS::Resolver->new(@conf, recurse => 1 ); # set up resolver for preamble +my $resolver = Net::DNS::Resolver->new(@conf, recurse => 1 ); # create resolver object my @ip = $resolver->nameservers(@server); -my @ns = NS($resolver, $domain); # find NS serving domain -die join(' ', $resolver->string, "\n", uc $domain, "not known by nameserver", @ip) unless @ns; +my @ns = NS($domain); # find NS serving domain +my @nsdname = sort map{lc $_->nsdname} @ns; # extract server names from NS records -my $zone = $ns[0]->name; # find zone cut -for ( "$zone." ) { # show RR for domain name - listRR($resolver, $domain, 'ANY') unless /$domain[.]?/; -} -my @soa = listRR($resolver, $zone, 'SOA'); # show SOA -report('SOA query fails for', uc "$zone.") unless @soa; +my $zone = @ns ? $ns[0]->name : ''; # find zone name + +my @soa = listRR($zone, 'SOA'); # show SOA +report("SOA query fails for $zone.") unless @soa; foreach ( @soa ) { # simple sanity check + my $mname = lc $_->mname; # primary server report('no retry when zone transfer fails') if ($_->refresh + $_->retry) > $_->expire; report('minimum TTL exceeds zone expiry time') if $_->minimum > $_->expire; - next if query($resolver, $_->mname, 'A')->answer; - next if query($resolver, $_->mname, 'AAAA')->answer; - report('unresolvable name:', uc $_->mname); # RFC2181, 7.3 + next if grep{$_ eq $mname} @nsdname; # NS list includes primary server + next if $resolver->query($mname, 'A'); # or address records exist + next if $resolver->query($mname, 'AAAA'); # (unlisted primary is never tested) + report('unresolved MNAME field:', "$mname."); # RFC2181, 7.3 +} + +for ( "$zone." ) { # show RR for domain if relevant + listRR($domain, 'ANY') unless /$domain/i; } print "----\n"; if ( @server ) { - checkNS($zone, @ip > 1 ? sort @ip : @server); # check nominated server + my @nominated = map{@server > 1 ? $_ : "@server $_"} sort @ip; + checkNS($zone, @nominated); } else { - my @dns = sort map { $_->nsdname } @ns; # server names from NS records - my ($errors, @etc) = checkNS($zone, @dns); # report status - my $n = @dns; - print "\nUnexpected response from $errors of $n nameservers\n\n" if $errors; + my $n = @nsdname || $resolver->print; # suspect resolver if no NS + my ($errors, @etc) = checkNS($zone, @nsdname); # report status + print "\nUnexpected response from $errors of $n nameservers\n" if $errors; } +print "\n"; exit; @@ -149,41 +157,55 @@ sleep(1+$duration) unless eval { defined select(undef, undef, undef, $duration) }; } -sub checkNS { # check servers (in parallel) and report status + +sub checkNS { # check nameservers (in parallel) and report status my $zone = shift; my $index = @_ || return (0,0); # server list empty - my $ns = pop @_; # remove last element of list + my ($ns, $if) = split / /, pop @_||return(0,0); # name/interface at end of list my $res = Net::DNS::Resolver->new(@conf); # use clean resolver for each test - my @ip = $res->nameservers($ns); # point at nameserver + my @xip = sort $res->nameservers($if || $ns); # point at nameserver + my $ip = pop @xip; # last (or only) interface + $res->nameservers($ip) if @xip; + # send query packet to nameserver + my ($socket, $sent) = ($res->bgsend($zone,'SOA'), time) if $ip and not @server; - my $parallel = (@ip == 1) unless @server; # parallel query if exactly one IP - my ($socket, $sent) = ($res->bgsend($zone,'SOA'), time) if $parallel; - - my @pass = checkNS($zone, @_); # recurse to do others in parallel + my @pass = checkNS($zone, @_); # recurse to query others in parallel # pick up response as recursion unwinds - print "\n[$index]\t$ns (",join(', ',@ip),")\n"; # identify server - my ($fail, $latest, %soa) = @pass; # use prebuilt return values my @fail = @pass; $fail[0]++; - unless ( @ip ) { # no address + if ( @xip and $socket ) { # special handling for multihomed server + until ($res->bgisready($socket)) { # wait for outstanding query to complete + last if time > ($sent + $udp_timeout); + catnap($udp_wait); + } + } + foreach (@xip) { # iterate over remaining interfaces + my ($f, @etc) = checkNS($zone, (undef)x@_, "$ns $_"); # pass name/IP pair + @pass = @fail if $f; # propagate failure to caller + } + + my %nsname; # identify nameserver + unless ( $ip ) { + print "\n[$index]\t$ns\n"; report('unresolved server name'); return @fail; + } elsif ( $ns eq $ip ) { + print "\n[$index]\t$ip\n"; + } else { + print "\n[$index]\t$ns ($ip)\n"; + $nsname{$ns}++; } if ( $verbose ) { - my %dname; - foreach ( @ip ) { # collect names from PTR records - $dname{lc $ns}++ unless /$ns/; # and from NS if available - foreach ( grep{$_->type eq 'PTR'} listRR($resolver, $_) ) { - $dname{lc $_->ptrdname}++; - } + foreach ( grep{$_->type eq 'PTR'} listRR($ip) ) { + $nsname{lc $_->ptrdname}++; } - foreach ( sort keys %dname ) { # show address info - listRR($resolver, $_, 'A'); - listRR($resolver, $_, 'AAAA'); + foreach my $ns ( sort keys %nsname ) { # show address records + listRR($ns, 'A'); + listRR($ns, 'AAAA'); } } @@ -193,66 +215,60 @@ last if time > ($sent + $udp_timeout); catnap($udp_wait); # snatch a few milliseconds sleep } - $packet = $res->bgread($socket) if $_; + $packet = $res->bgread($socket) if $_; # read response if available } else { - $packet = query($res, $zone, 'SOA'); # using sequential query model + $packet = $res->send($zone, 'SOA'); # use sequential query model } - unless ( $packet ) { # ... is no more, has ceased to be + unless ( $packet ) { # ... is no more! It has ceased to be! report('no response'); return @fail; } unless ( $packet->header->rcode eq 'NOERROR' ) { report($packet->header->rcode); # NXDOMAIN or fault at nameserver - return @fail; + return @fail; # RFC2308, 2.1 } - my @aa = $packet->header->aa ? qw(aa) : (); # authoritative answer - my @tc = $packet->header->tc ? qw(tc) : (); # truncated response + my $aa = $packet->header->aa; # authoritative answer + my $tc = $packet->header->tc ? 'tc' : ''; # truncated response my @answer = $packet->answer; # answer section + my @soa = grep{$_->type eq 'SOA'} @answer; # SOA records (plural!) my @result = @fail; # analyse response - if ( @answer ) { - @result = @pass if @aa; # RFC1034, 6.2.1 (1) - report('non-authoritative answer') unless @aa; # RFC1034, 6.2.1 (2) - } elsif ( grep{$_->type eq 'SOA'} $packet->authority ) { - report('NCACHE response from nameserver'); # RFC2308, 2.2 (1)(2) + if ( @soa ) { + @result = @pass if $aa; # RFC2181, 6.1 + report('non-authoritative answer') unless $aa; # RFC1034, 6.2.1 (2) + } elsif ( @soa = grep{$_->type eq 'SOA'} $packet->authority ) { + my $ttl = $soa[0]->ttl; # RFC2308, 2.2 (1)(2) + report("NCACHE response (ttl $ttl seconds)"); } elsif ( grep{$_->type eq 'NS'} $packet->authority ) { - report('referral received from nameserver'); # RFC1034, 6.2.6 + report('referral received from nameserver'); # RFC2308, 2.2 (4) + return @fail; # RFC2181, 6.1 } else { report('NODATA response from nameserver'); # RFC2308, 2.2 (3) - } - - my @soa = grep{$_->type eq 'SOA'} @answer; # extract SOA records (plural!) - - unless ( @soa ) { # no answer for SOA query - @result = @fail; # RFC2181, 6.1 - report('SOA query failed'); - return @result unless @aa; # RFC1034, 3.7 - @soa = grep{$_->type eq 'SOA'} $packet->authority; - return @result unless @soa; + return @fail; # RFC2181, 6.1 } my $serial; # zone serial number foreach ( @soa ) { - print @tc, "\t\t\tzone serial\t", ($serial = $_->serial), "\n"; + print "$tc\t\t\tzone serial\t", ($serial = $_->serial), "\n"; $_->serial(0); # key on constant fields only $_->ttl(0); next if $soa{lc $_->string}++; # skip repeated occurrences next unless keys %soa > 1; # zone should have unique SOA - report('SOA record not unique'); # RFC1034, 4.2.1 + report('SOA record not unique'); # RFC2181, 6.1 @result = (@fail, %soa); } return @result if $serial == $latest; # server has latest data - unless ( @aa and ($serial > $latest) ) { # unexpected serial number + unless ( $aa and ($serial > $latest) ) { # unexpected serial number report('serial number not current') if $latest; return (@fail, %soa); } - my $unrep = $index-1 - $fail; # all previous out of date + my $unrep = $latest ? (@_ - $fail) : 0; # all previous out of date my $s = $unrep > 1 ? 's' : ''; # pedants really are revolting! report("at least $unrep previously unreported stale serial number$s") if $unrep; return ($result[0]+$unrep, $serial, %soa); # restate partial result @@ -260,41 +276,39 @@ sub listRR { # print all RR for specified name - my $packet = query(@_) || return (); # get specified RRs + my $packet = $resolver->send(@_) || return (); # get specified RRs my $na = $packet->header->tc ? 'tc' : ''; # non-auth response my $aa = $packet->header->aa ? "aa $na" : $na; # authoritative answer my $qname = ($packet->question)[0]->qname; my @answer = $packet->answer; foreach ( @answer ) { # print RR with status flags - print $_->name eq $qname ? $aa : $na, "\t"; - $_->print; + my $string = $_->string; # display IPv6 compact form + $string =~ s/(:[:0]*:)(?!.*::|.+\1)/::/o if $_->type eq 'AAAA'; + print $_->name eq $qname ? $aa : $na, "\t$string\n"; } return @answer; } sub NS { # find nameservers for domain - my @resolver = ref $_[0] ? (shift) : (); # optional resolver arg - my $domain = shift; # name or IP address + my $domain = shift || '.'; # name or IP address my @ns = (); + my $version = Net::DNS::version(); while ( $domain ) { - my $packet = query(@resolver, $domain, 'NS') || return (); - last if @ns = grep {$_->type eq 'NS'} $packet->answer; + my $packet = $resolver->send($domain, 'NS') || return (); + last if @ns = grep{$_->type eq 'NS'} $packet->answer; ($_, $domain) = split /\./, ($packet->question)[0]->qname, 2; + die "\tIPv6 feature not implemented in Net::DNS $version\n" if /:/; + if ( my @soa = grep{$_->type eq 'SOA'} $packet->authority ) { + $domain = $soa[0]->name; # zone cut + } } return @ns; } -sub query { # query nameservers - my $resolver = ref $_[0] ? shift : Net::DNS::Resolver->new; - return $resolver->send(@_) || return undef; -} - - sub report { # concatenate strings into fault report print join(' ', '*'x4, @_, "\n"); } __END__ - diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/demo/README new/Net-DNS-0.59/demo/README --- old/Net-DNS-0.58/demo/README 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/demo/README 2006-09-18 21:22:10.000000000 +0200 @@ -11,6 +11,11 @@ check_soa Perl version of the check_soa program presented in _DNS and BIND_ by Paul Albitz & Cricket Liu. + Also see the check_soa version in the Contrib + directory which is an fires off the queries in + parallel. + + check_zone Checks a zone for errors like missing PTR records. Can recurse into subdomains. See also a hacked version in contrib/check_zone. @@ -22,4 +27,4 @@ perldig Performs DNS queries and print the results. --- -$Id: README 264 2005-04-06 09:16:15Z olaf $ +$Id: README 607 2006-09-17 18:20:28Z olaf $ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/lib/Net/DNS/Packet.pm new/Net-DNS-0.59/lib/Net/DNS/Packet.pm --- old/Net-DNS-0.58/lib/Net/DNS/Packet.pm 2006-07-04 10:06:26.000000000 +0200 +++ new/Net-DNS-0.59/lib/Net/DNS/Packet.pm 2006-09-18 21:22:12.000000000 +0200 @@ -1,6 +1,6 @@ package Net::DNS::Packet; # -# $Id: Packet.pm 579 2006-04-18 09:12:04Z olaf $ +# $Id: Packet.pm 605 2006-09-13 13:12:33Z olaf $ # use strict; @@ -22,7 +22,7 @@ @EXPORT_OK = qw(dn_expand); -$VERSION = (qw$LastChangedRevision: 579 $)[1]; +$VERSION = (qw$LastChangedRevision: 605 $)[1]; @@ -223,16 +223,9 @@ $rrobj->print if $debug; } } else { - my ($qname, $qtype, $qclass) = @_; - - $qtype = "A" unless defined $qtype; - $qclass = "IN" unless defined $qclass; - $self{"header"} = Net::DNS::Header->new; $self{"header"}->qdcount(1); - $self{"question"} = [ Net::DNS::Question->new($qname, - $qtype, - $qclass) ]; + $self{"question"} = [ Net::DNS::Question->new(@_) ]; $self{"answer"} = []; $self{"authority"} = []; $self{"additional"} = []; diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/lib/Net/DNS/Question.pm new/Net-DNS-0.59/lib/Net/DNS/Question.pm --- old/Net-DNS-0.58/lib/Net/DNS/Question.pm 2006-07-04 10:06:26.000000000 +0200 +++ new/Net-DNS-0.59/lib/Net/DNS/Question.pm 2006-09-18 21:22:12.000000000 +0200 @@ -1,6 +1,6 @@ package Net::DNS::Question; # -# $Id: Question.pm 546 2005-12-16 15:23:03Z olaf $ +# $Id: Question.pm 610 2006-09-18 16:46:43Z olaf $ # use strict; BEGIN { @@ -12,7 +12,7 @@ use Carp; use Net::DNS; -$VERSION = (qw$LastChangedRevision: 546 $)[1]; +$VERSION = (qw$LastChangedRevision: 610 $)[1]; =head1 NAME @@ -40,40 +40,60 @@ sub new { my $class = shift; - my %self = ( - "qname" => undef, - "qtype" => undef, - "qclass" => undef, - ); - - my ($qname, $qtype, $qclass) = @_; - - $qname = "" if !defined($qname); - - $qtype = defined($qtype) ? uc($qtype) : "ANY"; - $qclass = defined($qclass) ? uc($qclass) : "ANY"; - - # Check if the caller has the type and class reversed. - # We are not that kind for unknown types.... :-) - if ((!exists $Net::DNS::typesbyname{$qtype} || - !exists $Net::DNS::classesbyname{$qclass}) - && exists $Net::DNS::classesbyname{$qtype} - && exists $Net::DNS::typesbyname{$qclass}) { - ($qtype, $qclass) = ($qclass, $qtype); + my $qname = shift || ''; + my $qtype = uc shift || 'A'; + my $qclass = uc shift || 'IN'; + + $qname =~ s/\.+$//o; # strip gratuitous trailing dot + + + + # Check if the caller has the type and class reversed. + # We are not that kind for unknown types.... :-) + if ((!exists $Net::DNS::typesbyname{$qtype} || + !exists $Net::DNS::classesbyname{$qclass}) + && exists $Net::DNS::classesbyname{$qtype} + && exists $Net::DNS::typesbyname{$qclass}) { + ($qtype, $qclass) = ($qclass, $qtype); + } + + + # if name is an IP address do appropriate PTR query + if ( $qname =~ m/:|\d$/ ) { + ($qname, $qtype) = ($_, 'PTR') if $_ = dns_addr($qname); } - $qname =~ s/^\.+//o; - $qname =~ s/\.+$//o; - $self{"qname"} = $qname; - $self{"qtype"} = $qtype; - $self{"qclass"} = $qclass; + + + my %self = ( qname => $qname, + qtype => $qtype, + qclass => $qclass + ); bless \%self, $class; } +sub dns_addr { + my $arg = shift; # name or IP6/IP4 address + + # If arg looks like IP4 address then map to in-addr.arpa space + if ( $arg =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)$/o ) { + return "$4.$3.$2.$1.in-addr.arpa" + } + + # If arg looks like IP6 address then map to ip6.arpa space + if ( $arg =~ /^((\w*:)+)(\w*)$/o ) { + my @parse = split /:/, (reverse "${1}0${3}"), 8; + my $hex = pack 'A4'x8, map{/^$/ ? ('0000')x(9-@parse) : $_.'000'} @parse; + return join '.', split(//, $hex), 'ip6.arpa'; + } + return undef; +} + + # @@ -190,6 +210,8 @@ Portions Copyright (c) 2002-2004 Chris Reinhardt. +Portions Copyright (c) 2003,2006 Dick Franks. + All rights reserved. This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/lib/Net/DNS/RR.pm new/Net-DNS-0.59/lib/Net/DNS/RR.pm --- old/Net-DNS-0.58/lib/Net/DNS/RR.pm 2006-07-04 10:06:26.000000000 +0200 +++ new/Net-DNS-0.59/lib/Net/DNS/RR.pm 2006-09-18 21:22:12.000000000 +0200 @@ -1,6 +1,6 @@ package Net::DNS::RR; # -# $Id: RR.pm 593 2006-05-25 09:40:39Z olaf $ +# $Id: RR.pm 607 2006-09-17 18:20:28Z olaf $ # use strict; @@ -14,7 +14,7 @@ use Net::DNS::RR::Unknown; -$VERSION = (qw$LastChangedRevision: 593 $)[1]; +$VERSION = (qw$LastChangedRevision: 607 $)[1]; =head1 NAME @@ -163,12 +163,24 @@ } else { # Die only if we are dealing with a version for which DLV is # available - die $@ if ( - defined ($Net::DNS::SEC::SVNVERSION) && - ( $Net::DNS::SEC::SVNVERSION > 591 ) - ); + die $@ if defined ($Net::DNS::SEC::HAS_DLV) ; + } + eval { + local $SIG{'__DIE__'} = 'DEFAULT'; + require Net::DNS::RR::NSEC3; + }; + + unless ($@) { + $RR{'NSEC3'} =1; + } else { + # Die only if we are dealing with a version for which NSEC3 is + # available + die $@ if defined ($Net::DNS::SEC::HAS_NSEC3); + } + + } } diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/lib/Net/DNS/Resolver/Base.pm new/Net-DNS-0.59/lib/Net/DNS/Resolver/Base.pm --- old/Net-DNS-0.58/lib/Net/DNS/Resolver/Base.pm 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/lib/Net/DNS/Resolver/Base.pm 2006-09-18 21:22:10.000000000 +0200 @@ -1,6 +1,6 @@ package Net::DNS::Resolver::Base; # -# $Id: Base.pm 581 2006-04-21 07:46:45Z olaf $ +# $Id: Base.pm 610 2006-09-18 16:46:43Z olaf $ # use strict; @@ -25,7 +25,7 @@ use Net::DNS; use Net::DNS::Packet; -$VERSION = (qw$LastChangedRevision: 581 $)[1]; +$VERSION = (qw$LastChangedRevision: 610 $)[1]; # @@ -411,111 +411,52 @@ sub search { my $self = shift; - my ($name, $type, $class) = @_; - my $ans; + my $name = shift || '.'; - $type ||= 'A'; - $class ||= 'IN'; + my $defdomain = $self->{domain} if $self->{defnames}; + my @searchlist = @{$self->{searchlist}} if $self->{dnsrch}; - # If the name looks like an IP address then do an appropriate - # PTR query. - if ($name =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { - $name = "$4.$3.$2.$1.in-addr.arpa."; - $type = 'PTR'; - } - - # pass IPv6 addresses right to query() - if (index($name, ':') > 0 and index($name, '.') < 0) { - return $self->query($name); - } - - # If the name contains at least one dot then try it as is first. - if (index($name, '.') >= 0) { - print ";; search($name, $type, $class)\n" if $self->{'debug'}; - $ans = $self->query($name, $type, $class); - return $ans if $ans and $ans->header->ancount; - } - - # If the name doesn't end in a dot then apply the search list. - if (($name !~ /\.$/) && $self->{'dnsrch'}) { - foreach my $domain (@{$self->{'searchlist'}}) { - my $newname = "$name.$domain"; - print ";; search($newname, $type, $class)\n" - if $self->{'debug'}; - $ans = $self->query($newname, $type, $class); - return $ans if $ans and $ans->header->ancount; - } + # resolve name by trying as absolute name, then applying searchlist + my @list = (undef, @searchlist); + for ($name) { + # resolve name with no dots or colons by applying searchlist (or domain) + @list = @searchlist ? @searchlist : ($defdomain) unless m/[:.]/; + # resolve name with trailing dot as absolute name + @list = (undef) if m/\.$/; } - # Finally, if the name has no dots then try it as is. - if (index($name, '.') < 0) { - print ";; search($name, $type, $class)\n" if $self->{'debug'}; - $ans = $self->query("$name.", $type, $class); - return $ans if $ans and $ans->header->ancount; - } + foreach my $suffix ( @list ) { + my $fqname = join '.', $name, ($suffix || ()); + + print ';; search(', join(', ', $fqname, @_), ")\n" if $self->{debug}; - # No answer was found. + my $packet = $self->send($fqname, @_) || return undef; + + return $packet if $packet->header->ancount; # answer found + + last if ($packet->question)[0]->qtype eq 'PTR'; # abort search if IP + } return undef; } sub query { - my ($self, $name, $type, $class) = @_; + my $self = shift; + my $name = shift || '.'; - $type ||= 'A'; - $class ||= 'IN'; - # If the name doesn't contain any dots then append the default domain. - if ((index($name, '.') < 0) && (index($name, ':') < 0) && $self->{'defnames'}) { - $name .= ".$self->{domain}"; - } - - # If the name looks like an IP address then do an appropriate - # PTR query. - if ($name =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { - $name = "$4.$3.$2.$1.in-addr.arpa"; - $type = 'PTR'; - } - - # IPv4 address in IPv6 format (very lax regex) - if ($name =~ /^[0:]*:ffff:(\d+)\.(\d+)\.(\d+)\.(\d+)$/i) { - $name = "$4.$3.$2.$1.in-addr.arpa"; - $type = 'PTR'; - } - - # if the name looks like an IPv6 0-compressed IP address then expand - # PTR query. (eg 2001:5c0:0:1::2) - if ($name =~ /::/) { - # avoid stupid "Use of implicit split to @_ is deprecated" warning - while (scalar(my @parts = split (/:/, $name)) < 8) { - $name =~ s/::/:0::/; - } - $name =~ s/::/:0:/; - } - - # if the name looks like an IPv6 address then do appropriate - # PTR query. (eg 2001:5c0:0:1:0:0:0:2) - if ($name =~ /:/) { - my (@stuff) = split (/:/, $name); - if (@stuff == 8) { - $name = 'ip6.arpa.'; - $type = 'PTR'; - foreach my $segment (@stuff) { - $segment = sprintf ("%04s", $segment); - $segment =~ m/(.)(.)(.)(.)/; - $name = "$4.$3.$2.$1.$name"; - } - } else { - # no idea what this is - } - } - print ";; query($name, $type, $class)\n" if $self->{'debug'}; - my $packet = Net::DNS::Packet->new($name, $type, $class); + # resolve name containing no dots or colons by appending domain + my @suffix = ($self->{domain} || ()) if $name !~ m/[:.]/ and $self->{defnames}; - my $ans = $self->send($packet); + my $fqname = join '.', $name, @suffix; - return $ans && $ans->header->ancount ? $ans : undef; + print ';; query(', join(', ', $fqname, @_), ")\n" if $self->{debug}; + + my $packet = $self->send($fqname, @_) || return undef; + + return $packet if $packet->header->ancount; # answer found + return undef; } @@ -1116,20 +1057,7 @@ if (ref($_[0]) and $_[0]->isa('Net::DNS::Packet')) { $packet = shift; } else { - my ($name, $type, $class) = @_; - - $name ||= ''; - $type ||= 'A'; - $class ||= 'IN'; - - # If the name looks like an IP address then do an appropriate - # PTR query. - if ($name =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/o) { - $name = "$4.$3.$2.$1.in-addr.arpa."; - $type = 'PTR'; - } - - $packet = Net::DNS::Packet->new($name, $type, $class); + $packet = Net::DNS::Packet->new(@_); } if ($packet->header->opcode eq 'QUERY') { @@ -1599,8 +1527,8 @@ Copyright (c) 1997-2002 Michael Fuhr. Portions Copyright (c) 2002-2004 Chris Reinhardt. - Portions Copyright (c) 2005 Olaf Kolkman <olaf@net-dns.org> +Portions Copyright (c) 2006 Dick Franks. All rights reserved. This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/lib/Net/DNS.pm new/Net-DNS-0.59/lib/Net/DNS.pm --- old/Net-DNS-0.58/lib/Net/DNS.pm 2006-07-04 10:06:26.000000000 +0200 +++ new/Net-DNS-0.59/lib/Net/DNS.pm 2006-09-18 21:22:12.000000000 +0200 @@ -1,6 +1,7 @@ + package Net::DNS; # -# $Id: DNS.pm 596 2006-07-04 07:42:36Z olaf $ +# $Id: DNS.pm 606 2006-09-16 08:03:35Z olaf $ # use strict; @@ -41,7 +42,7 @@ @ISA = qw(Exporter DynaLoader); - $VERSION = '0.58'; + $VERSION = '0.59'; $HAVE_XS = eval { local $SIG{'__DIE__'} = 'DEFAULT'; __PACKAGE__->bootstrap(); 1 @@ -144,6 +145,7 @@ 'MAILB' => 253, # RFC 1035 (MB, MG, MR) 'MAILA' => 254, # RFC 1035 (obsolete - see MX) 'ANY' => 255, # RFC 1035 + 'NSEC3' => 65324, # draft-ietf-dnsext-nsec3-07 (experimental typecode, not permanent) 'DLV' => 32769 # RFC 4431 in Net::DNS::SEC ); %typesbyval = reverse %typesbyname; diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/t/00-load.t new/Net-DNS-0.59/t/00-load.t --- old/Net-DNS-0.58/t/00-load.t 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/t/00-load.t 2006-09-18 21:22:09.000000000 +0200 @@ -1,4 +1,4 @@ -# $Id: 00-load.t 593 2006-05-25 09:40:39Z olaf $ -*-perl-*- +# $Id: 00-load.t 604 2006-09-07 18:47:16Z olaf $ -*-perl-*- use Test::More tests => 77; @@ -19,7 +19,7 @@ return $INC{"Net/DNS/RR/$rr.pm"} ? 1 : 0; } -my %skip = map { $_ => 1 } qw(SIG NXT KEY DS NSEC RRSIG DNSKEY DLV); +my %skip = map { $_ => 1 } qw(SIG NXT KEY DS NSEC RRSIG DNSKEY DLV NSEC3); my @rrs = grep { !$skip{$_} } keys %Net::DNS::RR::RR; diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/t/03-question.t new/Net-DNS-0.59/t/03-question.t --- old/Net-DNS-0.58/t/03-question.t 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/t/03-question.t 2006-09-18 21:22:09.000000000 +0200 @@ -1,6 +1,6 @@ -# $Id: 03-question.t 264 2005-04-06 09:16:15Z olaf $ +# $Id: 03-question.t 610 2006-09-18 16:46:43Z olaf $ -use Test::More tests => 11; +use Test::More tests => 17; use strict; BEGIN { use_ok('Net::DNS'); } @@ -35,3 +35,24 @@ is($q->qname, 'example.net', 'qname()' ); is($q->qtype, 'A', 'qtype()' ); is($q->qclass, 'CH', 'qclass()' ); + + + + +my $q2= Net::DNS::Question->new("::1","IN","A"); +is ($q2->qname, '1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa','v6: qname()'); +is($q2->qtype, 'PTR', 'v6: qtype()' ); +is($q2->qclass, 'IN', 'v6: qclass()' ); + + +my $q3= Net::DNS::Question->new("192.168.1.16","IN","A"); +is($q3->qname, '16.1.168.192.in-addr.arpa','v4: qname()'); +is($q3->qtype, 'PTR', 'v4: qtype()' ); +is($q3->qclass, 'IN', 'v4: qclass()' ); + + + +use Data::Dumper; + +my $q4= Net::DNS::Question->new("8a"); +print Dumper $q4; diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/t/05-rr.t new/Net-DNS-0.59/t/05-rr.t --- old/Net-DNS-0.58/t/05-rr.t 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/t/05-rr.t 2006-09-18 21:22:09.000000000 +0200 @@ -1,9 +1,9 @@ -# $Id: 05-rr.t 593 2006-05-25 09:40:39Z olaf $ -*-perl-*- +# $Id: 05-rr.t 607 2006-09-17 18:20:28Z olaf $ -*-perl-*- use Test::More; use strict; -use vars qw( $HAS_DNSSEC $HAS_DLV ); +use vars qw( $HAS_DNSSEC $HAS_DLV $HAS_NSEC3); my $keypathrsa="Kexample.com.+005+24866.private"; my $rsakeyrr; @@ -13,11 +13,10 @@ eval {require Net::DNS::SEC;} ){ $HAS_DNSSEC=1; - if (defined ($Net::DNS::SEC::SVNVERSION) && - ( $Net::DNS::SEC::SVNVERSION > 591 ) - ){ - $HAS_DLV =1; + if (defined ($HAS_DLV=$Net::DNS::SEC::HAS_DLV)) + { plan tests => 254; + $HAS_NSEC3=$Net::DNS::SEC::HAS_NSEC3; }else{ plan tests => 253; } @@ -64,6 +63,11 @@ 83F6A1E4469DA50A )"); ok( $dlv, "DLV RR created"); } + + if ($HAS_NSEC3){ + diag("NSEC3 Supported in this version of Net::DNS::SEC (no tests yet)"); + } + } diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/t/08-online.t new/Net-DNS-0.59/t/08-online.t --- old/Net-DNS-0.58/t/08-online.t 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/t/08-online.t 2006-09-18 21:22:09.000000000 +0200 @@ -1,4 +1,4 @@ -# $Id: 08-online.t 490 2005-10-05 13:14:07Z olaf $ -*-perl-*- +# $Id: 08-online.t 605 2006-09-13 13:12:33Z olaf $ -*-perl-*- use Test::More; use strict; @@ -113,7 +113,7 @@ searchlist => ['t.net-dns.org', 'net-dns.org'], ); - +#$res->debug(1); # # test the search() and query() append the default domain and # searchlist correctly. @@ -135,6 +135,7 @@ method => 'query', name => 'a', }, + ); diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-DNS-0.58/t/11-inet6.t new/Net-DNS-0.59/t/11-inet6.t --- old/Net-DNS-0.58/t/11-inet6.t 2006-07-04 10:06:24.000000000 +0200 +++ new/Net-DNS-0.59/t/11-inet6.t 2006-09-18 21:22:09.000000000 +0200 @@ -1,4 +1,4 @@ -# $Id: 11-inet6.t 579 2006-04-18 09:12:04Z olaf $ -*-perl-*- +# $Id: 11-inet6.t 600 2006-07-17 07:06:12Z olaf $ -*-perl-*- my $has_inet6; @@ -60,7 +60,7 @@ my $A_address; -SKIP: { skip "online tests are not enabled", 2 unless -e 't/online.enabled'; +SKIP: { skip "online tests are not enabled", 3 unless -e 't/online.enabled'; # First use the local resolver to query for the AAAA record of a # well known nameserver, than use v6 transport to get to that record. ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Remember to have fun... --------------------------------------------------------------------- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org