@@ -1,6 +1,20 @@
-$Id: Changes 1256 2014-08-22 22:02:17Z willem $ -*-text-*-
+$Id: Changes 1267 2014-09-22 08:03:42Z willem $ -*-text-*-
+**** 0.80 Sep 22, 2014
+
+Removal of Win32::IPHelper support with cygwin
+
+ Resolvers on Cygwin can get their DNS configuration from the
+ registry directly via the /proc filesystem. Getting rid of
+ the other method reduces dependencies and makes installations
+ less error prone.
+
+Rework rt.cpan.org #96119
+
+ "Too late to run INIT block" warning for require Net::DNS
+
+
**** 0.79 Aug 22, 2014
Feature rt.cpan.org #98149
@@ -43,5 +43,5 @@
}
},
"release_status" : "stable",
- "version" : "0.79"
+ "version" : "0.80"
}
@@ -25,4 +25,4 @@ requires:
MIME::Base64: 2.11
Test::More: 0.52
perl: 5.00404
-version: 0.79
+version: 0.80
@@ -1,5 +1,5 @@
-# $Id: Makefile.PL 1191 2014-04-09 09:06:32Z willem $ -*-perl-*-
+# $Id: Makefile.PL 1263 2014-09-15 12:56:22Z willem $ -*-perl-*-
use strict;
$^W = 1;
@@ -50,22 +50,21 @@ my $help = 0;
my $IPv6_tests;
my $online_tests = 2; # 2 = non-fatal, 1 = on, 0 = off
my $use_xs;
-my $iphelper = 2; # only relevant for Cygwin
- # 2 = use when installed, 1 = use, 0 = don't use
-my @options = (
+
+my @options = (
'xs!' => \$use_xs,
'pm' => sub {
warn qq/\n\tWARNING: Use of "--pm" is deprecated. Use "--noxs" instead.\n\n/;
$use_xs = 0;
},
'online-tests!' => \$online_tests,
- 'non-fatal-online-tests' => sub { $online_tests = 2; },
+ 'non-fatal-online-tests' => sub {
+ $online_tests = 2;
+ },
'IPv6-tests!' => \$IPv6_tests,
- 'help!' => \$help
+ 'help!' => \$help
);
-push @options, ( 'iphelper!' => \$iphelper ) if ( $^O eq 'cygwin' );
-
unless ( GetOptions(@options) ) {
print "Error: Unrecognized option.\n";
@@ -73,6 +72,7 @@ unless ( GetOptions(@options) ) {
exit 1;
}
+
if ($help) {
print <<EOT;
@@ -95,46 +95,10 @@ Prepare Makefile for building and installing Net::DNS
make test. This is the default.
EOT
- print <<EOT if ( $^O eq 'cygwin' );
- --iphelper --noiphelper Use the Win32::IPHelper module to determine
- network parameters like which nameservers to
- use. When freshly installing Net::DNS, the
- default is to *not* use Win32::IPHelper and
- read those values from /proc/registry.
- When updating, the default is to copy what the
- installed version did.
-
-EOT
exit 0;
}
-if ( $^O eq 'cygwin' ) {
- # Just testing if Net::DNS::Resolver::Win32 is installed, but
- # Net::DNS::Resolver needs to be required first for it to load
- # successfully (if available).
- my $iphelper_present = '';
- eval { require Net::DNS::Resolver; require Net::DNS::Resolver::Win32; };
- $iphelper_present ||= $INC{'Net/DNS/Resolver/Win32.pm'} unless $@;
-
- eval { require Net::DNS::Resolver; require Net::DNS::Resolver::MSWin32; };
- $iphelper_present ||= $INC{'Net/DNS/Resolver/MSWin32.pm'} unless $@;
-
- $iphelper = ( $iphelper_present ? 1 : 0 ) if $iphelper == 2;
-
- die <<EOT if $iphelper_present && ! $iphelper;
-You have indicated a wish to remove Win32::IPHelper usage. However, you are
-either doing a reinstall or an upgrade of an installation which *did* use
-Win32::IPHelper. In your case, you have to delete the file:
-
- $iphelper_present
-
-by hand first, to build and install Net::DNS in this way.
-EOT
-
- print "Build will" . ( $iphelper ? "" : " not" ) . " use Win32::IPHelper.\n\n";
-}
-
#
# List of files to be removed by make clean
@@ -143,7 +107,6 @@ my @debris = qw(
t/IPv6.enabled
t/online.enabled t/online.nonfatal
compile.* DNS.o DNS.c DNS.bs
- lib/Net/DNS/Resolver/MSWin32
zone[0-9].txt zone[0-9][0-9].txt
);
@@ -172,31 +135,27 @@ my %Makefile = (
);
-if ( $^O eq 'MSWin32' || $^O eq "cygwin" && $iphelper ) {
+if ( $^O eq "MSWin32" ) {
+
unless (eval {
local $SIG{__WARN__} = sub { };
require WIN32::API;
}
) {
- warn <<AMEN;
+
+ print <<AMEN;
I can not find WIN32::API version 0.55 or higher.
I will add WIN32::API to the list of prerequisites.
-AMEN
-
- if ( $^O eq "MSWin32" ) {
- warn <<AMEN2;
Note that, WIN32::API is included in recent versions
of ActivePerl (5.10 since build 1003) and recent
versions of Strawberry perl (at least in the October
version of 5.10.0.3) and the module has not be
tested with other versions. In case of failure please
consider upgrading.
-AMEN2
- }
-
-
+AMEN
}
+
$Makefile{'PREREQ_PM'}->{'enum'} = 1.0; # Dependency for Win32::IPHelper
$Makefile{'PREREQ_PM'}->{'Win32::IPHelper'} = 0.07;
$Makefile{'PREREQ_PM'}->{'Win32::API'} = 0.55;
@@ -345,7 +304,7 @@ EOF
my $ar = exists $Config{'full_ar'} ? $Config{'full_ar'} : $Config{'ar'};
my $cr = ( $^O eq 'MSWin32' && $Config{'cc'} eq 'cl' ? '/OUT:' : 'cr ' ); # ar action
- $ret = system( "$ar $cr compile$Config{lib_ext} compile$Config{obj_ext}" )
+ $ret = system("$ar $cr compile$Config{lib_ext} compile$Config{obj_ext}")
unless $ret;
foreach my $file ( glob('compile*') ) {
@@ -382,6 +341,9 @@ netdns$(LIB_EXT): netdns$(OBJ_EXT)
sub MY::libscan {
my $path = $_[1];
return '' if $path =~ /\B\.svn\b/;
- return '' if $^O eq 'cygwin' && !$iphelper && $path =~ /Resolver[^\w]MSWin32\.pm$/;
return $path;
}
+
+
+__END__
+
@@ -1,16 +1,16 @@
package Net::DNS::Parameters;
#
-# $Id: Parameters.pm 1246 2014-08-14 19:39:22Z willem $
+# $Id: Parameters.pm 1261 2014-09-11 10:14:45Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1246 $)[1];
+$VERSION = (qw$LastChangedRevision: 1261 $)[1];
################################################
##
## Domain Name System (DNS) Parameters
-## (last updated 2014-08-12)
+## (last updated 2014-09-04)
##
################################################
@@ -102,8 +102,8 @@ use vars qw( %typebyname %typebyval );
NINFO => 56, #
RKEY => 57, #
TALINK => 58, #
- CDS => 59, # RFC-ietf-dnsop-delegation-trust-maintainance-14
- CDNSKEY => 60, # RFC-ietf-dnsop-delegation-trust-maintainance-14
+ CDS => 59, # RFC7344
+ CDNSKEY => 60, # RFC7344
OPENPGPKEY => 61, # draft-ietf-dane-openpgpkey
SPF => 99, # RFC7208
UINFO => 100, # IANA-Reserved
@@ -1,10 +1,10 @@
package Net::DNS::RR;
#
-# $Id: RR.pm 1235 2014-07-29 07:58:19Z willem $
+# $Id: RR.pm 1260 2014-09-09 09:12:28Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1235 $)[1];
+$VERSION = (qw$LastChangedRevision: 1260 $)[1];
=head1 NAME
@@ -65,7 +65,7 @@ sub new {
scalar @_ > 2 ? &_new_hash : &_new_string;
} || do {
my $class = shift || __PACKAGE__;
- my @param = map { !defined($_) ? 'undef': split; } @_;
+ my @param = map { !defined($_) ? 'undef' : split; } @_;
croak join ' ', "$@in new $class(", substr( "@param", 0, 50 ), '... )';
};
}
@@ -118,15 +118,12 @@ sub _new_string {
my ( $ttl, $class );
unless ( defined $t2 ) { # <name> <type>
@token = ('ANY') if $classbyname{$t1}; # <name> <class>
- } elsif ( defined $t3 && $classbyname{$t2} ) {
- $ttl = shift @token; # <name> <ttl> <class> <type>
- $class = shift @token;
- } elsif ( $t1 =~ /^\d/ ) {
- $ttl = shift @token; # <name> <ttl> [<class>] <type>
- $class = shift @token if $t2 =~ /^CLASS\d/;
} elsif ( $classbyname{$t1} || $t1 =~ /^CLASS\d/ ) {
$class = shift @token; # <name> <class> [<ttl>] <type>
$ttl = shift @token if $t2 =~ /^\d/;
+ } elsif ( $t1 =~ /^\d/ ) {
+ $ttl = shift @token; # <name> <ttl> [<class>] <type>
+ $class = shift @token if $classbyname{$t2} || $t2 =~ /^CLASS\d/;
}
my $type = shift(@token);
@@ -655,9 +652,9 @@ sub encode_rdata { ## encode rdata as wire-format octet string
sub format_rdata { ## format rdata portion of RR string
my $self = shift;
- my $data = $self->{'rdata'} || $self->encode_rdata; # unknown RR, per RFC3597
- my $size = length $data;
- join ' ', '\\#', $size, $size ? unpack( 'H*', $data ) : ();
+ my $data = $self->{'rdata'} || $self->encode_rdata;
+ my $size = length($data) || return '';
+ join ' ', '\\#', $size, unpack 'H*', $data; # RFC3597 unknown RR format
}
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::Base;
#
-# $Id: Base.pm 1252 2014-08-19 13:14:41Z willem $
+# $Id: Base.pm 1260 2014-09-09 09:12:28Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1252 $)[1];
+$VERSION = (qw$LastChangedRevision: 1260 $)[1];
use strict;
@@ -30,7 +30,7 @@ sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
#
# A few implementation notes wrt IPv6 support.
#
-# In general we try to be gracious to those stacks that do not have ipv6 support.
+# In general we try to be gracious to those stacks that do not have IPv6 support.
# We test that by means of the availability of Socket6 and IO::Socket::INET6
#
@@ -47,8 +47,8 @@ sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
# call to translate IP addresses to socketaddress
-# Two configuration flags, force_v4 and prefer_v6, are provided to
-# control IPv6 behaviour for test purposes.
+# Three configuration flags, force_v4, prefer_v6 and force_v6,
+# are provided to control IPv6 behaviour for test purposes.
# Olaf Kolkman, RIPE NCC, December 2003.
@@ -89,17 +89,16 @@ BEGIN {
errorstring => 'unknown error or no error',
tsig_rr => undef,
answerfrom => '',
- querytime => undef,
tcp_timeout => 120,
udp_timeout => undef,
- axfr_sel => undef,
persistent_tcp => 0,
persistent_udp => 0,
dnssec => 0,
+ adflag => 0, # this is only used when {dnssec} == 1
cdflag => 0, # this is only used when {dnssec} == 1
- adflag => 1, # this is only used when {dnssec} == 1
udppacketsize => 0, # value bounded below by PACKETSZ
- force_v4 => 0, # only relevant when we have v6 support
+ force_v4 => 0, # only relevant if IPv6 is supported
+ force_v6 => 0, #
prefer_v6 => 0, # prefer v6, otherwise prefer v4
ignqrid => 0, # normally packets with non-matching ID
# or with the qr bit on are thrown away,
@@ -110,7 +109,7 @@ BEGIN {
# This may be a temporary feature
);
- # If we're running under a SOCKSified Perl, use TCP instead of UDP
+ # If running under a SOCKSified Perl, use TCP instead of UDP
# and keep the sockets open.
if ( $Config::Config{'usesocks'} ) {
$defaults{'usevc'} = 1;
@@ -122,8 +121,7 @@ BEGIN {
sub defaults { return $defaults; }
}
-# These are the attributes that we let the user specify in the new().
-# We also deprecate access to these with AUTOLOAD (some may be useful).
+# These are the attributes that the user may specify in the new() constructor.
my %public_attr = map { $_ => 1 } qw(
nameservers
port
@@ -145,6 +143,7 @@ my %public_attr = map { $_ => 1 } qw(
persistent_tcp
persistent_udp
dnssec
+ adflag
cdflag
prefer_v6
ignqrid
@@ -288,10 +287,11 @@ sub print { print shift->string; }
sub string {
my $self = shift;
- my $timeout = $self->{'tcp_timeout'} ? $self->{'tcp_timeout'} : 'indefinite';
- my $INET6line = $has_inet6 ? "prefer_v6 = $self->{prefer_v6}" : '(no IPv6 transport)';
- my $ignqrid = $self->{'ignqrid'} ? 'ACCEPTING ALL PACKETS (IGNQRID)' : '';
- my @nslist = $self->nameservers();
+ my $timeout = $self->{'tcp_timeout'} || 'indefinite';
+ my $IP6line = "prefer_v6\t= $self->{prefer_v6}\tforce_v6 = $self->{force_v6}";
+ my $IP6conf = $has_inet6 ? $IP6line : '(no IPv6 transport)';
+ my @nslist = $self->nameservers();
+ my $ignqrid = $self->{'ignqrid'} ? 'ACCEPTING ALL PACKETS (IGNQRID)' : '';
return <<END;
;; RESOLVER state:
;; domain = $self->{domain}
@@ -301,12 +301,12 @@ sub string {
;; srcport = $self->{srcport}
;; srcaddr = $self->{srcaddr}
;; tcp_timeout = $timeout
-;; retrans = $self->{retrans} retry = $self->{retry}
-;; usevc = $self->{usevc} stayopen = $self->{stayopen}
-;; defnames = $self->{defnames} dnsrch = $self->{dnsrch}
-;; recurse = $self->{recurse} igntc = $self->{igntc}
-;; force_v4 = $self->{force_v4} $INET6line
-;; debug = $self->{debug} $ignqrid
+;; retrans = $self->{retrans} retry = $self->{retry}
+;; usevc = $self->{usevc} stayopen = $self->{stayopen}
+;; defnames = $self->{defnames} dnsrch = $self->{dnsrch}
+;; recurse = $self->{recurse} igntc = $self->{igntc}
+;; debug = $self->{debug} force_v4 = $self->{force_v4} $ignqrid
+;; $IP6conf
END
}
@@ -372,22 +372,15 @@ sub nameservers {
return unless defined wantarray;
}
- my @returnval;
- if ( $self->force_v4() ) {
- @returnval = @{$self->{nameserver4}};
- } elsif ( $self->prefer_v6() ) {
- @returnval = ( @{$self->{nameserver6}}, @{$self->{nameserver4}} );
- } else {
- @returnval = ( @{$self->{nameserver4}}, @{$self->{nameserver6}} );
- }
+ my @ns4 = @{$self->{nameserver4}} unless $self->force_v6;
+ my @ns6 = @{$self->{nameserver6}} if $has_inet6 && !$self->force_v4;
+ my @returnval = $self->prefer_v6 ? ( @ns6, @ns4 ) : ( @ns4, @ns6 );
return @returnval if scalar @returnval;
$self->errorstring('no nameservers');
- if ( scalar( @{$self->{nameserver6}} ) ) {
- $self->errorstring('IPv6 transport not available') unless $has_inet6;
- $self->errorstring('unable to use IPv6 transport') if $self->force_v4();
- }
+ $self->errorstring('IPv4 transport not available') if scalar(@ns4) < scalar @{$self->{nameserver4}};
+ $self->errorstring('IPv6 transport not available') if scalar(@ns6) < scalar @{$self->{nameserver6}};
return @returnval;
}
@@ -426,12 +419,24 @@ sub cname_addr {
# then we use EDNS and $self->{udppacketsize}
# should be taken as the maximum packet_data length
sub _packetsz {
- my $udpsize = shift->{udppacketsize} || PACKETSZ;
+ my $udpsize = shift->{udppacketsize} || 0;
return $udpsize > PACKETSZ ? $udpsize : PACKETSZ;
}
+sub answerfrom {
+ my $self = shift;
+ $self->{answerfrom} = shift if scalar @_;
+ return $self->{answerfrom};
+}
+
+sub errorstring {
+ my $self = shift;
+ $self->{errorstring} = shift if scalar @_;
+ return $self->{errorstring};
+}
+
sub _reset_errorstring {
- my ($self) = @_;
+ my $self = shift;
$self->errorstring( $self->defaults->{'errorstring'} );
}
@@ -1085,22 +1090,25 @@ sub make_query_packet {
$header->rd( $self->{recurse} ) if $header->opcode eq 'QUERY';
- if ( $self->dnssec ) { # RFC 3225
- print ";; Set EDNS DO flag and UDP packetsize $self->{udppacketsize}\n" if $self->{debug};
- $packet->edns->size( $self->{udppacketsize} ); # advertise UDP payload size for local IP stack
- $header->do(1);
- $header->ad( $self->{adflag} );
- $header->cd( $self->{cdflag} );
+ unless ( $self->dnssec ) {
+ $header->ad(0);
+ $header->do(0);
- } elsif ( $self->{udppacketsize} > PACKETSZ ) {
- print ";; Clear EDNS DO flag and set UDP packetsize $self->{udppacketsize}\n" if $self->{debug};
- $packet->edns->size( $self->{udppacketsize} ); # advertise UDP payload size for local IP stack
+ } elsif ( $self->{adflag} ) {
+ print ";; Set AD flag\n" if $self->{debug};
+ $header->ad(1);
+ $header->cd(0);
$header->do(0);
} else {
- $header->do(0);
+ print ";; Set EDNS DO flag\n" if $self->{debug};
+ $header->ad(0);
+ $header->cd( $self->{cdflag} );
+ $header->do(1);
}
+ $packet->edns->size( $self->{udppacketsize} ); # advertise payload size for local stack
+
if ( $self->{tsig_rr} && !grep $_->type eq 'TSIG', $packet->additional ) {
$packet->sign_tsig( $self->{tsig_rr} );
}
@@ -1484,6 +1492,44 @@ sub _ip_is_ipv6 {
}
+sub force_v4 {
+ my $self = shift;
+ return $self->{force_v4} unless scalar @_;
+ my $value = shift;
+ $self->force_v6(0) if $value;
+ $self->{force_v4} = $value ? 1 : 0;
+}
+
+sub force_v6 {
+ my $self = shift;
+ return $self->{force_v6} unless scalar @_;
+ my $value = shift;
+ $self->force_v4(0) if $value;
+ $self->{force_v6} = $value ? 1 : 0;
+}
+
+sub prefer_v4 {
+ my $self = shift;
+ return $self->{prefer_v6} ? 0 : 1 unless scalar @_;
+ my $value = shift;
+ $self->{prefer_v6} = $value ? 0 : 1;
+ return $value;
+}
+
+sub prefer_v6 {
+ my $self = shift;
+ return $self->{prefer_v6} unless scalar @_;
+ $self->{prefer_v6} = shift() ? 1 : 0;
+}
+
+
+sub udppacketsize {
+ my $self = shift;
+ $self->{udppacketsize} = shift if scalar @_;
+ return $self->_packetsz;
+}
+
+
sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup)
use vars qw($AUTOLOAD);
@@ -1494,7 +1540,7 @@ sub AUTOLOAD { ## Default method
my $name = $AUTOLOAD;
$name =~ s/.*://;
- croak "$name: no such method" unless exists $self->{$name};
+ croak "$name: no such method" unless exists $public_attr{$name};
no strict q/refs/;
*{$AUTOLOAD} = sub {
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::MSWin32;
#
-# $Id: MSWin32.pm 1244 2014-08-12 22:10:45Z willem $
+# $Id: MSWin32.pm 1258 2014-09-04 12:23:18Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1244 $)[1];
+$VERSION = (qw$LastChangedRevision: 1258 $)[1];
=head1 NAME
@@ -56,11 +56,10 @@ sub init {
my @nameservers = map { $_->{IpAddress} } @{$FIXED_INFO->{DnsServersList}};
$defaults->nameservers( _untaint @nameservers );
+ my $devolution = 0;
my @searchlist = _untaint lc $FIXED_INFO->{DomainName};
$defaults->domain(@searchlist);
- my $usedevolution = 0;
-
if (WINREG) {
# The Win32::IPHelper does not return searchlist.
@@ -81,28 +80,27 @@ sub init {
push @searchlist, split m/[\s,]+/, $searchlist;
my ( $value, $type ) = $reg_tcpip->GetValue('UseDomainNameDevolution');
- $usedevolution = defined $value && $type == REG_DWORD ? hex $value : 0;
+ $devolution = defined $value && $type == REG_DWORD ? hex $value : 0;
}
}
# fix devolution if configured, and simultaneously
# make sure no dups (but keep the order)
- my @a;
- my %h;
+ my @list;
+ my %seen;
foreach my $entry (@searchlist) {
- push( @a, $entry ) unless $h{$entry}++;
+ push( @list, $entry ) unless $seen{$entry}++;
- if ($usedevolution) {
+ next unless $devolution;
- # as long there are more than two pieces, cut
- while ( $entry =~ m#\..+\.# ) {
- $entry =~ s#^[^\.]+\.(.+)$#$1#;
- push( @a, $entry ) unless $h{$entry}++;
- }
+ # as long there are more than two pieces, cut
+ while ( $entry =~ m#\..+\.# ) {
+ $entry =~ s#^[^\.]+\.(.+)$#$1#;
+ push( @list, $entry ) unless $seen{$entry}++;
}
}
- $defaults->searchlist( _untaint @a );
+ $defaults->searchlist( _untaint @list );
$defaults->read_env;
}
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::Recurse;
#
-# $Id: Recurse.pm 1252 2014-08-19 13:14:41Z willem $
+# $Id: Recurse.pm 1259 2014-09-08 10:33:49Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1252 $)[1];
+$VERSION = (qw$LastChangedRevision: 1259 $)[1];
=head1 NAME
@@ -168,8 +168,8 @@ sub send {
print ";; find missing glue for $domain. ($ns)\n" if $res->{debug};
$res->empty_nameservers();
my @ip = $res->nameservers($ns);
- next unless @ip;
$ns = [@ip]; # substitute IP list in situ
+ next unless @ip;
my $reply = $res->send($query) || next;
$res->{callback}->($reply) if $res->{callback};
return $reply;
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::cygwin;
#
-# $Id: cygwin.pm 1244 2014-08-12 22:10:45Z willem $
+# $Id: cygwin.pm 1258 2014-09-04 12:23:18Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1244 $)[1];
+$VERSION = (qw$LastChangedRevision: 1258 $)[1];
=head1 NAME
@@ -18,16 +18,13 @@ use base qw(Net::DNS::Resolver::Base);
sub getregkey {
- my $key = $_[0] . $_[1];
- my $value;
+ my $key = join '/', @_;
local *LM;
-
- if ( open( LM, "<$key" ) ) {
- $value = <LM>;
- $value =~ s/\0+$// if $value;
- close(LM);
- }
+ open( LM, "<$key" ) or return '';
+ my $value = <LM>;
+ $value =~ s/\0+$// if $value;
+ close(LM);
return $value || '';
}
@@ -41,12 +38,12 @@ sub init {
local *LM;
- my $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters/';
+ my $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/Tcpip/Parameters';
unless ( -d $root ) {
# Doesn't exist, maybe we are on 95/98/Me?
- $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/VxD/MSTCP/';
+ $root = '/proc/registry/HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Services/VxD/MSTCP';
-d $root || Carp::croak "can't read registry: $!";
}
@@ -58,8 +55,11 @@ sub init {
# If nothing else, the searchlist should probably contain our own domain
# also see below for domain name devolution if so configured
# (also remove any duplicates later)
- my $searchlist = "$domain ";
- $searchlist .= getregkey( $root, 'SearchList' );
+ my $devolution = getregkey( $root, 'UseDomainNameDevolution' );
+ my $searchlist = getregkey( $root, 'SearchList' );
+ my @searchlist = _untaint $domain;
+ $defaults->domain(@searchlist);
+ push @searchlist, split m/[\s,]+/, $searchlist;
# This is (probably) adequate on NT4
@@ -70,49 +70,41 @@ sub init {
}
- my @nameservers;
-
- #
# but on W2K/XP the registry layout is more advanced due to dynamically
# appearing connections. So we attempt to handle them, too...
# opt to silently fail if something isn't ok (maybe we're on NT4)
# If this doesn't fail override any NT4 style result we found, as it
# may be there but is not valid.
# drop any duplicates later
- my $dnsadapters = $root . 'DNSRegisteredAdapters/';
+ my @nameservers;
+
+ my $dnsadapters = join '/', $root, 'DNSRegisteredAdapters';
if ( opendir( LM, $dnsadapters ) ) {
my @adapters = grep !/^\.\.?$/, readdir(LM);
closedir(LM);
foreach my $adapter (@adapters) {
- my $regadapter = $dnsadapters . $adapter . '/';
- if ( -e $regadapter ) {
- my $ns = getregkey( $regadapter, 'DNSServerAddresses' );
- until ( length($ns) < 4 ) {
- push @nameservers, join '.', unpack( 'C4', $ns );
- substr( $ns, 0, 4 ) = '';
- }
+ my $ns = getregkey( $dnsadapters, $adapter, 'DNSServerAddresses' );
+ until ( length($ns) < 4 ) {
+ push @nameservers, join '.', unpack( 'C4', $ns );
+ substr( $ns, 0, 4 ) = '';
}
}
}
- my $interfaces = $root . 'Interfaces/';
+ my $interfaces = join '/', $root, 'Interfaces';
if ( opendir( LM, $interfaces ) ) {
my @ifacelist = grep !/^\.\.?$/, readdir(LM);
closedir(LM);
foreach my $iface (@ifacelist) {
- my $regiface = $interfaces . $iface . '/';
- opendir( LM, $regiface ) || next;
- closedir(LM);
-
- my $ip = getregkey( $regiface, 'DhcpIPAddress' )
- || getregkey( $regiface, 'IPAddress' );
+ my $ip = getregkey( $interfaces, $iface, 'DhcpIPAddress' )
+ || getregkey( $interfaces, $iface, 'IPAddress' );
next unless $ip;
next if $ip eq '0.0.0.0';
foreach (
grep length,
- getregkey( $regiface, 'NameServer' ),
- getregkey( $regiface, 'DhcpNameServer' )
+ getregkey( $interfaces, $iface, 'NameServer' ),
+ getregkey( $interfaces, $iface, 'DhcpNameServer' )
) {
push @nameservers, split;
last;
@@ -121,34 +113,25 @@ sub init {
}
@nameservers = @nt4nameservers unless @nameservers;
- $defaults->nameservers(@nameservers);
-
- $defaults->domain($domain) if $domain;
+ $defaults->nameservers( _untaint @nameservers );
- my $usedevolution = getregkey( $root, 'UseDomainNameDevolution' );
- if ($searchlist) {
- # fix devolution if configured, and simultaneously make sure no dups (but keep the order)
- my @a;
- my %h;
- foreach my $entry ( split( m/[\s,]+/, $searchlist ) ) {
- push( @a, $entry ) unless $h{$entry}++;
+ # fix devolution if configured, and simultaneously
+ # make sure no dups (but keep the order)
+ my @list;
+ my %seen;
+ foreach my $entry (@searchlist) {
+ push @list, $entry unless $seen{$entry}++;
- if ($usedevolution) {
+ next unless $devolution;
- # as long there are more than two pieces, cut
- while ( $entry =~ m#\..+\.# ) {
- $entry =~ s#^[^\.]+\.(.+)$#$1#;
- push( @a, $entry ) unless $h{$entry}++;
- }
- }
+ # as long there are more than two pieces, cut
+ while ( $entry =~ m#\..+\.# ) {
+ $entry =~ s#^[^\.]+\.(.+)$#$1#;
+ push @list, $entry unless $seen{$entry}++;
}
- $defaults->searchlist(@a);
}
-
- $defaults->domain( _untaint $defaults->domain ); # untaint config values
- $defaults->searchlist( _untaint $defaults->searchlist );
- $defaults->nameservers( _untaint $defaults->nameservers );
+ $defaults->searchlist( _untaint @list );
$defaults->read_env;
}
@@ -1,10 +1,10 @@
package Net::DNS::Resolver;
#
-# $Id: Resolver.pm 1223 2014-06-26 22:04:29Z willem $
+# $Id: Resolver.pm 1266 2014-09-22 08:00:05Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1223 $)[1];
+$VERSION = (qw$LastChangedRevision: 1266 $)[1];
=head1 NAME
@@ -18,23 +18,11 @@ use strict;
use vars qw(@ISA);
BEGIN {
- for ($^O) { ## Perl OS identifier
-
- /cygwin/ && do {
- if ( eval "require Net::DNS::Resolver::MSWin32;" ) {
- @ISA = qw(Net::DNS::Resolver::MSWin32);
- last;
- }
- };
-
- if ( eval "require Net::DNS::Resolver::$_;" ) {
- @ISA = ("Net::DNS::Resolver::$_");
- last;
- }
-
- require Net::DNS::Resolver::UNIX;
- @ISA = qw(Net::DNS::Resolver::UNIX);
+ for ( $^O, 'UNIX' ) {
+ my $class = join '::', __PACKAGE__, $_;
+ return @ISA = ($class) if eval "require $class;";
}
+ die 'failed to load platform specific resolver component';
}
@@ -45,22 +33,22 @@ __END__
=head1 SYNOPSIS
- use Net::DNS;
+ use Net::DNS;
- my $res = Net::DNS::Resolver->new;
+ $resolver = new Net::DNS::Resolver();
- # Perform a lookup, using the searchlist if appropriate.
- my $answer = $res->search('example.com');
+ # Perform a lookup, using the searchlist if appropriate.
+ $reply = $resolver->search( 'example.com' );
- # Perform a lookup, without the searchlist
- my $answer = $res->query('example.com', 'MX');
+ # Perform a lookup, without the searchlist
+ $reply = $resolver->query( 'example.com', 'MX' );
- # Perform a lookup, without pre or post-processing
- my $answer = $res->send('example.com', 'MX', 'CH');
+ # Perform a lookup, without pre or post-processing
+ $reply = $resolver->send( 'example.com', 'MX', 'CH' );
- # Send a prebuilt packet
- my $packet = Net::DNS::Packet->new(...);
- my $answer = $res->send($packet);
+ # Send a prebuilt query packet
+ $query = new Net::DNS::Packet( ... );
+ $reply = $resolver->send( $packet );
=head1 DESCRIPTION
@@ -73,30 +61,31 @@ recursion is desired, etc.
=head2 new
- # Use the default configuration
- my $res = Net::DNS::Resolver->new;
+ # Use the default configuration
+ $resolver = new Net::DNS::Resolver();
- # Use my own configuration file
- my $res = Net::DNS::Resolver->new( config_file => '/my/dns.conf' );
+ # Use my own configuration file
+ $resolver = new Net::DNS::Resolver( config_file => '/my/dns.conf' );
- # Set options in the constructor
- my $res = Net::DNS::Resolver->new(
- nameservers => [qw(10.1.1.128 10.1.2.128)],
- recurse => 0,
- debug => 1,
- );
+ # Set options in the constructor
+ $resolver = new Net::DNS::Resolver(
+ nameservers => [ '10.1.1.128', '10.1.2.128' ],
+ recurse => 0,
+ debug => 1
+ );
Returns a resolver object. If no arguments are supplied, new()
returns an object having the default configuration.
-On UNIX systems, the default values are read from the following files,
+On Unix and Linux systems,
+the default values are read from the following files,
in the order indicated:
/etc/resolv.conf
$HOME/.resolv.conf
./.resolv.conf
-The following keywords are recognized in resolver configuration files:
+The following keywords are recognised in resolver configuration files:
=over 4
@@ -114,10 +103,9 @@ A space-separated list of nameservers to query.
=back
-Except for F</etc/resolv.conf>, files must be owned by the effective
-userid running the program or they won't be read. In addition, several
-environment variables can also contain configuration information; see
-L</ENVIRONMENT>.
+Except for F</etc/resolv.conf>, files will only be read if owned by the
+effective userid running the program. In addition, several environment
+variables may contain configuration information; see L</ENVIRONMENT>.
On Windows systems, an attempt is made to determine the system defaults
using the registry. Systems with many dynamically configured network
@@ -127,10 +115,10 @@ interfaces may confuse Net::DNS.
You can include a configuration file of your own when creating a
resolver object:
- # Use my own configuration file
- my $res = Net::DNS::Resolver->new(config_file => '/my/dns.conf');
+ # Use my own configuration file
+ $resolver = new Net::DNS::Resolver( config_file => '/my/dns.conf' );
-This is supported on both UNIX and Windows.
+This is supported on both Unix and Windows.
If a custom configuration file is specified at first instantiation,
@@ -149,12 +137,14 @@ A reference to an array of nameservers to query.
A reference to an array of domains to search for unqualified names.
+=item domain
+
+Domain name suffix to be appended to queries of unqualified names.
+
=item recurse
=item debug
-=item domain
-
=item port
=item srcaddr
@@ -192,14 +182,14 @@ of the same name.
=head2 search
- $packet = $res->search('mailhost');
- $packet = $res->search('mailhost.example.com');
- $packet = $res->search('192.168.1.1');
- $packet = $res->search('example.com', 'MX');
- $packet = $res->search('user.passwd.example.com', 'TXT', 'HS');
+ $packet = $resolver->search( 'mailhost' );
+ $packet = $resolver->search( 'mailhost.example.com' );
+ $packet = $resolver->search( '192.0.2.1' );
+ $packet = $resolver->search( 'example.com', 'MX' );
+ $packet = $resolver->search( 'annotation.example.com', 'TXT', 'HS' );
-Performs a DNS query for the given name, applying the searchlist
-if appropriate. The search algorithm is as follows:
+Performs a DNS query for the given name, applying the searchlist if
+appropriate. The search algorithm is as follows:
=over 4
@@ -209,74 +199,73 @@ If the name contains at least one dot, try it as is.
=item 2.
-If the name doesn't end in a dot then append each item in
-the search list to the name. This is only done if B<dnsrch>
-is true.
+If the name does not end in a dot, try appending each item in the
+search list to the name. This is only done if C<dnsrch> is true.
=item 3.
-If the name doesn't contain any dots, try it as is.
+If the name does not contain any dots, try it as is.
=back
-The record type and class can be omitted; they default to A and
-IN. If the name looks like an IP address (4 dot-separated numbers),
+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),
then an appropriate PTR query will be performed.
-Returns a "Net::DNS::Packet" object, or "undef" if no answers were
-found. If you need to examine the response packet whether it contains
+Returns a C<Net::DNS::Packet> object, or C<undef> if no answers were found.
+If you need to examine the response packet, whether it contains
any answers or not, use the send() method instead.
=head2 query
- $packet = $res->query('mailhost');
- $packet = $res->query('mailhost.example.com');
- $packet = $res->query('192.168.1.1');
- $packet = $res->query('example.com', 'MX');
- $packet = $res->query('user.passwd.example.com', 'TXT', 'HS');
+ $packet = $resolver->query( 'mailhost' );
+ $packet = $resolver->query( 'mailhost.example.com' );
+ $packet = $resolver->query( '192.0.2.1' );
+ $packet = $resolver->query( 'example.com', 'MX' );
+ $packet = $resolver->query( 'annotation.example.com', 'TXT', 'HS' );
Performs a DNS query for the given name; the search list is not
-applied. If the name doesn't contain any dots and B<defnames>
-is true then the default domain will be appended.
+applied. If the name does not contain any dots and C<defnames>
+is true, the default domain will be appended.
-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),
-then an appropriate PTR query will be performed.
+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),
+an appropriate PTR query will be performed.
-Returns a "Net::DNS::Packet" object, or "undef" if no answers were
-found. If you need to examine the response packet whether it contains
+Returns a C<Net::DNS::Packet> object, or C<undef> if no answers were found.
+If you need to examine the response packet, whether it contains
any answers or not, use the send() method instead.
=head2 send
- $packet = $res->send($packet_object);
- $packet = $res->send('mailhost.example.com');
- $packet = $res->send('example.com', 'MX');
- $packet = $res->send('user.passwd.example.com', 'TXT', 'HS');
+ $packet = $resolver->send( $packet );
+ $packet = $resolver->send( 'mailhost.example.com' );
+ $packet = $resolver->send( 'example.com', 'MX' );
+ $packet = $resolver->send( 'annotation.example.com', 'TXT', 'HS' );
Performs a DNS query for the given name. Neither the searchlist
nor the default domain will be appended.
The argument list can be either a C<Net::DNS::Packet> object or a list
of strings. 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),
-then an appropriate PTR query will be performed.
+A and IN. If the name looks like an IP address (IPv4 or IPv6),
+an appropriate PTR query will be performed.
Returns a C<Net::DNS::Packet> object whether there were any answers or not.
Use C<< $packet->header->ancount >> or C<< $packet->answer >> to find out
-if there were any records in the answer section. Returns C<undef> if there
-was an error.
+if there were any records in the answer section.
+Returns C<undef> if no response was received.
=head2 axfr
- @zone = $res->axfr;
- @zone = $res->axfr('example.com');
- @zone = $res->axfr('example.com', 'HS');
+ @zone = $resolver->axfr();
+ @zone = $resolver->axfr( 'example.com' );
+ @zone = $resolver->axfr( 'example.com', 'HS' );
- $iterator = $res->axfr;
- $iterator = $res->axfr('example.com');
- $iterator = $res->axfr('example.com', 'HS');
+ $iterator = $resolver->axfr();
+ $iterator = $resolver->axfr( 'example.com' );
+ $iterator = $resolver->axfr( 'example.com', 'HS' );
$rr = $iterator->();
@@ -289,47 +278,47 @@ in the resolver search list.
If the class is omitted, it defaults to IN.
-When called in list context, axfr() returns a list of L<Net::DNS::RR>
+When called in list context, axfr() returns a list of C<Net::DNS::RR>
objects or an empty list if the zone transfer failed.
The redundant SOA record that terminates the zone transfer is not
returned to the caller.
Here is an example that uses a timeout and TSIG verification:
- $res->tcp_timeout( 10 );
- $res->tsig( 'Khmac-sha1.example.+161+24053.private' );
- my @zone = $res->axfr( 'example.com' );
+ $resolver->tcp_timeout( 10 );
+ $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' );
+ @zone = $resolver->axfr( 'example.com' );
- die 'Zone transfer failed: ', $res->errorstring unless @zone;
+ die 'Zone transfer failed: ', $resolver->errorstring unless @zone;
- foreach my $rr (@zone) {
- $rr->print;
+ foreach $rr (@zone) {
+ $rr->print;
}
When called in scalar context, axfr() returns an iterator object.
-Each invocation of the iterator returns a single L<Net::DNS::RR>
-or undef when the zone is exhausted.
+Each invocation of the iterator returns a single C<Net::DNS::RR>
+or C<undef> when the zone is exhausted.
The redundant SOA record that terminates the zone transfer is not
returned to the caller.
Here is the example above, implemented using an iterator:
- $res->tcp_timeout( 10 );
- $res->tsig( 'Khmac-sha1.example.+161+24053.private' );
- my $iterator = $res->axfr( 'example.com' );
+ $resolver->tcp_timeout( 10 );
+ $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' );
+ $iterator = $resolver->axfr( 'example.com' );
- die 'Zone transfer failed: ', $res->errorstring unless $iterator;
+ die 'Zone transfer failed: ', $resolver->errorstring unless $iterator;
- while ( my $rr = $iterator->() ) {
- $rr->print;
+ while ( $rr = $iterator->() ) {
+ $rr->print;
}
=head2 nameservers
- @nameservers = $res->nameservers;
- $res->nameservers('192.168.1.1', '192.168.2.2', '192.168.3.3');
+ @nameservers = $resolver->nameservers();
+ $resolver->nameservers( '192.0.2.1', '192.0.2.2', '2001:DB8::3' );
Gets or sets the nameservers to be queried.
@@ -337,104 +326,101 @@ Also see the IPv6 transport notes below
=head2 empty_nameservers
- $res->empty_nameservers();
+ $resolver->empty_nameservers();
Empties the list of nameservers.
=head2 print
- $res->print;
+ $resolver->print;
Prints the resolver state on the standard output.
=head2 string
- print $res->string;
+ print $resolver->string;
Returns a string representation of the resolver state.
=head2 searchlist
- @searchlist = $res->searchlist;
- $res->searchlist('example.com', 'a.example.com', 'b.example.com');
+ @searchlist = $resolver->searchlist;
+ $resolver->searchlist( 'a.example', 'b.example', 'c.example' );
Gets or sets the resolver search list.
=head2 empty_searchlist
- $res->empty_searchlist();
+ $resolver->empty_searchlist();
Empties the searchlist.
=head2 port
- print 'sending queries to port ', $res->port, "\n";
- $res->port(9732);
+ print 'sending queries to port ', $resolver->port, "\n";
+ $resolver->port(9732);
-Gets or sets the port to which we send queries. This can be useful
-for testing a nameserver running on a non-standard port. The
-default is port 53.
+Gets or sets the port to which queries are sent.
+Convenient for nameserver testing using a non-standard port.
+The default is port 53.
=head2 srcport
- print 'sending queries from port ', $res->srcport, "\n";
- $res->srcport(5353);
+ print 'sending queries from port ', $resolver->srcport, "\n";
+ $resolver->srcport(5353);
-Gets or sets the port from which we send queries. The default is 0,
-meaning any port.
+Gets or sets the port from which queries are sent.
+The default is 0, meaning any port.
=head2 srcaddr
- print 'sending queries from address ', $res->srcaddr, "\n";
- $res->srcaddr('192.168.1.1');
+ print 'sending queries from address ', $resolver->srcaddr, "\n";
+ $resolver->srcaddr('192.0.2.1');
-Gets or sets the source address from which we send queries. Convenient
-for forcing queries out a specific interfaces on a multi-homed host.
+Gets or sets the source address from which queries are sent.
+Convenient for forcing queries from a specific interface on a
+multi-homed host.
The default is 0.0.0.0, meaning any local address.
=head2 bgsend
- $socket = $res->bgsend($packet_object) || die " $res->errorstring";
-
- $socket = $res->bgsend('mailhost.example.com');
- $socket = $res->bgsend('example.com', 'MX');
- $socket = $res->bgsend('user.passwd.example.com', 'TXT', 'HS');
-
+ $socket = $resolver->bgsend( $packet ) || die $resolver->errorstring;
+ $socket = $resolver->bgsend( 'mailhost.example.com' );
+ $socket = $resolver->bgsend( 'example.com', 'MX' );
+ $socket = $resolver->bgsend( 'annotation.example.com', 'TXT', 'HS' );
Performs a background DNS query for the given name, i.e., sends a
-query packet to the first nameserver listed in C<< $res->nameservers >>
-and returns immediately without waiting for a response. The program
-can then perform other tasks while waiting for a response from the
-nameserver.
+query packet to the first destination in the C<nameservers> list and
+returns immediately without waiting for a response. The program can
+then perform other tasks while awaiting the response from the nameserver.
The argument list can be either a C<Net::DNS::Packet> object or a list
of strings. The record type and class can be omitted; they default to
-A and IN. If the name looks like an IP address (4 dot-separated numbers),
-then an appropriate PTR query will be performed.
+A and IN. If the name looks like an IP address (IPv4 or IPv6),
+an appropriate PTR query will be performed.
Returns an C<IO::Socket::INET> object or C<undef> on error in which
case the reason for failure can be found through a call to the
errorstring method.
The program must determine when the socket is ready for reading and
-call C<< $res->bgread >> to get the response packet. You can use C<<
-$res->bgisready >> or C<IO::Select> to find out if the socket is ready
-before reading it.
+call C<bgread> to get the response packet. Either C<bgisready> or
+C<IO::Select> may be used to find out if the socket is ready.
-bgsend does not support persistent sockets.
+C<bgsend> does not support persistent sockets.
B<BEWARE>:
-bgsend does not support the usevc option (TCP) and operates on UDP only;
+C<bgsend> does not support the usevc option (TCP) and operates on UDP only.
Answers may not fit in an UDP packet and might be truncated. Truncated
packets will B<not> be retried over TCP automatically and should be handled
by the caller.
=head2 bgread
- $packet = $res->bgread($socket);
+ $packet = $resolver->bgread($socket);
if ($packet->header->tc) {
- # Retry over TCP (blocking).
+ # Retry over TCP (blocking).
}
undef $socket;
@@ -447,285 +433,248 @@ The programmer should close or destroy the socket object after reading it.
=head2 bgisready
- $socket = $res->bgsend('foo.example.com');
- until ($res->bgisready($socket)) {
- # do some other processing
+ $socket = $resolver->bgsend( 'foo.example.com' );
+ until ($resolver->bgisready($socket)) {
+ # do some other processing
}
- $packet = $res->bgread($socket);
+ $packet = $resolver->bgread($socket);
if ($packet->header->tc) {
- # Retry over TCP (blocking).
+ # Retry over TCP (blocking).
}
$socket = undef;
Determines whether a socket is ready for reading. The argument is
-an C<IO::Socket> object returned by C<< $res->bgsend >>.
+an C<IO::Socket> object returned by C<bgsend>.
Returns true if the socket is ready, false if not.
=head2 tsig
- $tsig = $res->tsig;
- $res->tsig( $tsig );
+ $tsig = $resolver->tsig;
+ $resolver->tsig( $tsig );
- $res->tsig( 'Khmac-sha1.example.+161+24053.private' );
+ $resolver->tsig( 'Khmac-sha1.example.+161+24053.private' );
- $res->tsig( 'Khmac-sha1.example.+161+24053.key' );
+ $resolver->tsig( 'Khmac-sha1.example.+161+24053.key' );
- $res->tsig( 'Khmac-sha1.example.+161+24053.key',
+ $resolver->tsig( 'Khmac-sha1.example.+161+24053.key',
fudge => 60
);
- $res->tsig( $key_name, $key );
+ $resolver->tsig( $key_name, $key );
- $res->tsig( undef );
+ $resolver->tsig( undef );
Get or set the TSIG record used to automatically sign outgoing
queries and updates. Call with an undefined argument, 0 or ''
to turn off automatic signing.
The default resolver behavior is not to sign any packets. You must
-call this method to set the key if you'd like the resolver to sign
-packets automatically.
+call this method to set the key if you would like the resolver to
+sign packets automatically.
-You can also sign packets manually -- see the C<Net::DNS::Packet>
-and C<Net::DNS::Update> manual pages for examples. TSIG records
+Packets can also be signed manually; see the L<Net::DNS::Packet>
+and L<Net::DNS::Update> manual pages for examples. TSIG records
in manually-signed packets take precedence over those that the
resolver would add automatically.
=head2 retrans
- print 'retrans interval: ', $res->retrans, "\n";
- $res->retrans(3);
+ print 'retrans interval: ', $resolver->retrans, "\n";
+ $resolver->retrans(3);
-Get or set the retransmission interval. The default is 5.
+Get or set the retransmission interval
+The default is 5 seconds.
=head2 retry
- print 'number of tries: ', $res->retry, "\n";
- $res->retry(2);
+ print 'number of tries: ', $resolver->retry, "\n";
+ $resolver->retry(2);
-Get or set the number of times to try the query. The default is 4.
+Get or set the number of times to try the query.
+The default is 4.
=head2 recurse
- print 'recursion flag: ', $res->recurse, "\n";
- $res->recurse(0);
+ print 'recursion flag: ', $resolver->recurse, "\n";
+ $resolver->recurse(0);
-Get or set the recursion flag. If this is true, nameservers will
-be requested to perform a recursive query. The default is true.
+Get or set the recursion flag.
+If true, this will direct nameservers to perform a recursive query.
+The default is true.
=head2 defnames
- print 'defnames flag: ', $res->defnames, "\n";
- $res->defnames(0);
+ print 'defnames flag: ', $resolver->defnames, "\n";
+ $resolver->defnames(0);
-Get or set the defnames flag. If this is true, calls to B<query> will
-append the default domain to names that contain no dots. The default
-is true.
+Get or set the defnames flag.
+If true, calls to C<query> will append the default domain to names
+that contain no dots.
+The default is true.
=head2 dnsrch
- print 'dnsrch flag: ', $res->dnsrch, "\n";
- $res->dnsrch(0);
+ print 'dnsrch flag: ', $resolver->dnsrch, "\n";
+ $resolver->dnsrch(0);
-Get or set the dnsrch flag. If this is true, calls to B<search> will
-apply the search list. The default is true.
+Get or set the dnsrch flag.
+If true, calls to C<search> will apply the search list to resolve
+names that are not fully qualified.
+The default is true.
=head2 debug
- print 'debug flag: ', $res->debug, "\n";
- $res->debug(1);
+ print 'debug flag: ', $resolver->debug, "\n";
+ $resolver->debug(1);
-Get or set the debug flag. If set, calls to B<search>, B<query>,
-and B<send> will print debugging information on the standard output.
+Get or set the debug flag.
+If set, calls to C<search>, C<query>, and C<send> will print
+debugging information on the standard output.
The default is false.
=head2 usevc
- print 'usevc flag: ', $res->usevc, "\n";
- $res->usevc(1);
+ print 'usevc flag: ', $resolver->usevc, "\n";
+ $resolver->usevc(1);
-Get or set the usevc flag. If true, then queries will be performed
-using virtual circuits (TCP) instead of datagrams (UDP). The default
-is false.
+Get or set the usevc flag.
+If true, queries will be performed using virtual circuits (TCP)
+instead of datagrams (UDP).
+The default is false.
=head2 tcp_timeout
- print 'TCP timeout: ', $res->tcp_timeout, "\n";
- $res->tcp_timeout(10);
+ print 'TCP timeout: ', $resolver->tcp_timeout, "\n";
+ $resolver->tcp_timeout(10);
-Get or set the TCP timeout in seconds. A timeout of C<undef> means
-indefinite. The default is 120 seconds (2 minutes).
+Get or set the TCP timeout in seconds.
+The default is 120 seconds (2 minutes).
+A timeout of C<undef> means indefinite.
=head2 udp_timeout
- print 'UDP timeout: ', $res->udp_timeout, "\n";
- $res->udp_timeout(10);
+ print 'UDP timeout: ', $resolver->udp_timeout, "\n";
+ $resolver->udp_timeout(10);
-Get or set the UDP timeout in seconds. A timeout of C<undef> means
-the retry and retrans settings will be just utilized to perform the
-retries until they are exhausted. The default is C<undef>.
+Get or set the UDP timeout in seconds.
+The default is C<undef>, which means that the retry and retrans
+settings will be used to perform the retries until they exhausted.
=head2 persistent_tcp
- print 'Persistent TCP flag: ', $res->persistent_tcp, "\n";
- $res->persistent_tcp(1);
+ print 'Persistent TCP flag: ', $resolver->persistent_tcp, "\n";
+ $resolver->persistent_tcp(1);
-Get or set the persistent TCP setting. If set to true, Net::DNS
-will keep a TCP socket open for each host:port to which it connects.
-This is useful if you're using TCP and need to make a lot of queries
+Get or set the persistent TCP setting.
+If true, Net::DNS will keep a TCP socket open for each host:port
+to which it connects.
+This is useful if you are using TCP and need to make a lot of queries
or updates to the same nameserver.
-This option defaults to false unless you're running under a
-SOCKSified Perl, in which case it defaults to true.
+The default is false unless you are running a SOCKSified Perl,
+in which case the default is true.
=head2 persistent_udp
- print 'Persistent UDP flag: ', $res->persistent_udp, "\n";
- $res->persistent_udp(1);
+ print 'Persistent UDP flag: ', $resolver->persistent_udp, "\n";
+ $resolver->persistent_udp(1);
-Get or set the persistent UDP setting. If set to true, Net::DNS
-will keep a single UDP socket open for all queries.
-This is useful if you're using UDP and need to make a lot of queries
+Get or set the persistent UDP setting.
+If true, Net::DNS will keep a single UDP socket open for all queries.
+This is useful if you are using UDP and need to make a lot of queries
or updates.
=head2 igntc
- print 'igntc flag: ', $res->igntc, "\n";
- $res->igntc(1);
+ print 'igntc flag: ', $resolver->igntc, "\n";
+ $resolver->igntc(1);
-Get or set the igntc flag. If true, truncated packets will be
-ignored. If false, truncated packets will cause the query to
-be retried using TCP. The default is false.
+Get or set the igntc flag.
+If true, truncated packets will be ignored.
+If false, the query will be retried using TCP.
+The default is false.
=head2 errorstring
- print 'query status: ', $res->errorstring, "\n";
+ print 'query status: ', $resolver->errorstring, "\n";
Returns a string containing the status of the most recent query.
=head2 answerfrom
- print 'last answer was from: ', $res->answerfrom, "\n";
+ print 'last answer was from: ', $resolver->answerfrom, "\n";
-Returns the IP address from which we received the last answer in
-response to a query.
+Returns the IP address from which the most recent packet was
+received in response to a query.
=head2 answersize
- print 'size of last answer: ', $res->answersize, "\n";
+ print 'size of last answer: ', $resolver->answersize, "\n";
-Returns the size in bytes of the last answer we received in
+Returns the size in bytes of the most recent packet received in
response to a query.
=head2 dnssec
- print "dnssec flag: ", $res->dnssec, "\n";
- $res->dnssec(0);
-
-Enabled DNSSEC this will set the checking disabled flag in the query header
-and add EDNS0 data as in RFC2671 and RFC3225
+ print "dnssec flag: ", $resolver->dnssec, "\n";
+ $resolver->dnssec(0);
-When set to true the answer and additional section of queries from
-secured zones will contain DNSKEY, NSEC and RRSIG records.
+The dnssec flag causes the resolver to transmit DNSSEC queries
+and to add a EDNS0 record as required by RFC2671 and RFC3225.
+The actions of, and response from, the remote nameserver is
+determined by the settings of the AD and CD flags.
-Setting calling the dnssec method with a non-zero value will set the
+Calling the dnssec() method with a non-zero value will also set the
UDP packet size to the default value of 2048. If that is too small or
-too big for your environment you should call the udppacketsize()
+too big for your environment, you should call the udppacketsize()
method immediately after.
- $res->dnssec(1); # turns on DNSSEC and sets udp packetsize to 2048
- $res->udppacketsize(1028); # lowers the UDP pakcet size
+ $resolver->dnssec(1); # DNSSEC using default packetsize
+ $resolver->udppacketsize(1250); # lower the UDP packet size
-The method will Croak::croak with the message "You called the
-Net::DNS::Resolver::dnssec() method but do not have Net::DNS::SEC
-installed at ..." if you call it without Net::DNS::SEC being in your
-@INC path.
+A fatal exception will be raised if the dnssec() method is called
+but the Net::DNS::SEC library has not been installed.
+=head2 adflag
-=head2 cdflag
-
- print "checking disabled flag: ", $res->dnssec, "\n";
- $res->dnssec(1);
- $res->cdflag(1);
-
-Sets or gets the CD bit for a dnssec query. This bit is always zero
-for non dnssec queries. When the dnssec is enabled the flag defaults to
-0 can be set to 1.
+ $resolver->dnssec(1);
+ $resolver->adflag(1);
+ print "authentication desired flag: ", $resolver->adflag, "\n";
+Gets or sets the AD bit for dnssec queries. This bit indicates that
+the caller is interested in the returned AD (authentic data) bit but
+does not require any dnssec RRs to be included in the response.
+The default value is 0.
-=head2 adflag
+=head2 cdflag
- print "checking disabled flag: ", $res->dnssec, "\n";
- $res->dnssec(1);
- $res->adflag(1);
+ $resolver->dnssec(1);
+ $resolver->cdflag(1);
+ print "checking disabled flag: ", $resolver->cdflag, "\n";
-Sets or gets the AD bit for a dnssec query. This bit is always zero
-for non dnssec queries. When the dnssec is enabled the flag defaults
-to 1.
+Gets or sets the CD bit for dnssec queries. This bit indicates that
+authentication by upstream nameservers should be suppressed.
+Any dnssec RRs required to execute the authentication procedure
+should be included in the response.
+The default value is 0.
=head2 udppacketsize
- print "udppacketsize: ", $res->udppacketsize, "\n";
- $res->udppacketsize(2048);
+ print "udppacketsize: ", $resolver->udppacketsize, "\n";
+ $resolver->udppacketsize(2048);
udppacketsize will set or get the packet size. If set to a value
greater than the default DNS packet size, an EDNS extension will be
added indicating support for UDP fragment reassembly.
-=head1 CUSTOMIZING
-
-Net::DNS::Resolver is actually an empty subclass. At compile time a
-super class is chosen based on the current platform. A side benefit of
-this allows for easy modification of the methods in Net::DNS::Resolver.
-You simply add a method to the namespace!
-
-For example, if we wanted to cache lookups:
-
- package Net::DNS::Resolver;
-
- my %cache;
-
- sub search {
- my ($self, @args) = @_;
-
- return $cache{@args} ||= $self->SUPER::search(@args);
- }
-
-
-=head1 IPv6 transport
-
-The Net::DNS::Resolver library will use IPv6 transport if the
-appropriate libraries (Socket6 and IO::Socket::INET6) are available
-and the address the server tries to connect to is an IPv6 address.
-
-The print() will method will report if IPv6 transport is available.
-
-You can use the force_v4() method with a non-zero argument
-to force IPv4 transport.
-
-The nameserver() method has IPv6 dependend behavior. If IPv6 is not
-available or IPv4 transport has been forced the nameserver() method
-will only return IPv4 addresses.
-
-For example
-
- $res->nameservers('192.168.1.1', '192.168.2.2', '2001:610:240:0:53:0:0:3');
- $res->force_v4(1);
- print join (" ",$res->nameserver());
-
-Will print: 192.168.1.1 192.168.2.2
-
-
-
-
=head1 ENVIRONMENT
The following environment variables can also be used to configure
@@ -734,22 +683,22 @@ the resolver:
=head2 RES_NAMESERVERS
# Bourne Shell
- RES_NAMESERVERS="192.168.1.1 192.168.2.2 192.168.3.3"
+ RES_NAMESERVERS="192.0.2.1 192.0.2.2 2001:DB8::3"
export RES_NAMESERVERS
# C Shell
- setenv RES_NAMESERVERS "192.168.1.1 192.168.2.2 192.168.3.3"
+ setenv RES_NAMESERVERS "192.0.2.1 192.0.2.2 2001:DB8::3"
A space-separated list of nameservers to query.
=head2 RES_SEARCHLIST
# Bourne Shell
- RES_SEARCHLIST="example.com sub1.example.com sub2.example.com"
+ RES_SEARCHLIST="a.example.com b.example.com c.example.com"
export RES_SEARCHLIST
# C Shell
- setenv RES_SEARCHLIST "example.com sub1.example.com sub2.example.com"
+ setenv RES_SEARCHLIST "a.example.com b.example.com c.example.com"
A space-separated list of domains to put in the search list.
@@ -774,23 +723,68 @@ The default domain.
setenv RES_OPTIONS "retrans:3 retry:2 debug"
A space-separated list of resolver options to set. Options that
-take values are specified as I<option>:I<value>.
+take values are specified as C<option:value>.
-=head1 BUGS
-Error reporting and handling needs to be improved.
+=head1 IPv6 TRANSPORT
+
+The Net::DNS::Resolver library will enable IPv6 transport if the
+appropriate libraries (Socket6 and IO::Socket::INET6) are available
+and the destination nameserver has at least one IPv6 address.
+
+The force_v4(), force_v6() and prefer_v6() methods with a non-zero
+argument may be used to configure transport selection.
+
+The behaviour of the nameserver() method illustrates the transport
+selection mechanism. If, for example, IPv6 is not available or IPv4
+transport has been forced, the nameserver() method will only return
+IPv4 addresses:
+
+ $resolver->nameservers( '192.0.2.1', '192.0.2.2', '2001:DB8::3' );
+ $resolver->force_v4(1);
+ print join ' ', $resolver->nameservers();
+
+will print
+
+ 192.0.2.1 192.0.2.2
+
+
+=head1 CUSTOMISED RESOLVERS
+
+Net::DNS::Resolver is actually an empty subclass. At compile time a
+super class is chosen based on the current platform. A side benefit of
+this allows for easy modification of the methods in Net::DNS::Resolver.
+You can simply add a method to the namespace!
+
+For example, if we wanted to cache lookups:
+
+ package Net::DNS::Resolver;
+
+ my %cache;
+
+ sub search {
+ $self = shift;
+
+ $cache{"@_"} ||= $self->SUPER::search(@_);
+ }
+
+
+=head1 BUGS
The current implementation supports TSIG only on outgoing packets.
No validation of server replies is performed.
-bgsend does not honor the usevc flag and only uses UDP for transport.
+bgsend() does not honour the usevc flag and only uses UDP for transport.
=head1 COPYRIGHT
-Copyright (c) 1997-2002 Michael Fuhr.
+Copyright (c)1997-2002 Michael Fuhr.
+
+Portions Copyright (c)2002-2004 Chris Reinhardt.
+
+Portions Copyright (c)2005 Olaf M. Kolkman, NLnet Labs.
-Portions Copyright (c) 2002-2004 Chris Reinhardt.
-Portions Copyright (c) 2005 Olaf M. Kolkman, NLnet Labs.
+Portions Copyright (c)2014 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.
@@ -1,11 +1,11 @@
package Net::DNS;
#
-# $Id: DNS.pm 1256 2014-08-22 22:02:17Z willem $
+# $Id: DNS.pm 1267 2014-09-22 08:03:42Z willem $
#
use vars qw($VERSION $SVNVERSION);
-$VERSION = '0.79';
-$SVNVERSION = (qw$LastChangedRevision: 1256 $)[1];
+$VERSION = '0.80';
+$SVNVERSION = (qw$LastChangedRevision: 1267 $)[1];
=head1 NAME
@@ -196,18 +196,16 @@ if (OLDDNSSEC) {
new Net::DNS::RR( type => $type );
}
- eval {
- #no warnings 'void'; ## DIY patch to suppress "Too late to run INIT block ..."
-
- sub INIT { ## only needed to satisfy DNSSEC t/00-load.t
- return unless OLDDNSSEC;
+ eval <<EOT;
+ no warnings 'void'; ## suppress "Too late to run INIT block ..."
- # attempt to pre-load RRs which have circular dependence problems
- foreach my $type (qw(NSEC3 NSEC3PARAM)) {
- new Net::DNS::RR( type => $type );
- }
+ sub INIT {
+ # deferred pre-load of RRs with intractable dependence problems
+ # required to satisfy Net::DNS::SEC t/00-load.t
+ new Net::DNS::RR( type => 'NSEC3' );
+ new Net::DNS::RR( type => 'NSEC3PARAM' );
}
- };
+EOT
}
@@ -1,7 +1,7 @@
-# $Id: 01-resolver-flags.t 1203 2014-05-20 12:25:01Z willem $ -*-perl-*-
+# $Id: 01-resolver-flags.t 1260 2014-09-09 09:12:28Z willem $ -*-perl-*-
use strict;
-use Test::More tests => 10;
+use Test::More tests => 12;
use Net::DNS;
@@ -22,7 +22,7 @@ ok( scalar(@warning), "expected warning: [@warning]" ) unless DNSSEC;
SKIP: {
- skip( 'Net::DNS::SEC not installed', 4 ) unless DNSSEC;
+ skip( 'Net::DNS::SEC not installed', 3 ) unless DNSSEC;
ok( $res->dnssec(), "dnssec flag toggles on" );
my $size = $res->udppacketsize();
@@ -31,11 +31,16 @@ SKIP: {
$res->dnssec(0);
ok( !$res->dnssec(), "dnssec flag toggles off" );
-
- ok( $res->adflag(), "default adflag on" );
}
+ok( !$res->adflag(), "default adflag off" );
+$res->adflag(1);
+ok( $res->adflag(), "toggle adflag on" );
+$res->adflag(0);
+ok( !$res->adflag(), "toggle adflag off" );
+
+
ok( !$res->cdflag(), "default cdflag off" );
$res->cdflag(1);
ok( $res->cdflag(), "toggle cdflag on" );
@@ -1,4 +1,4 @@
-# $Id: 01-resolver.t 1203 2014-05-20 12:25:01Z willem $ -*-perl-*-
+# $Id: 01-resolver.t 1263 2014-09-15 12:56:22Z willem $ -*-perl-*-
use strict;
use Test::More tests => 48;
@@ -9,7 +9,7 @@ use Net::DNS;
my $res = Net::DNS::Resolver->new();
for (@Net::DNS::Resolver::ISA) {
- diag "$_\t($^O)" unless /[:]UNIX$/;
+ diag $_ unless /[:]UNIX$/;
}
isa_ok( $res, 'Net::DNS::Resolver', 'new() created object' );