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
- A 'parallel implementation' of the
- check_soa script in the examples
- directory
check_zone Dennis Glatting
@@ -19,4 +16,4 @@
loclist.pl Christopher Davis
---
-$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 nameservers for a domain
+B - 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
+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