@@ -1,4 +1,33 @@
-$Id: Changes 1231 2014-07-10 09:12:57Z willem $ -*-text-*-
+$Id: Changes 1256 2014-08-22 22:02:17Z willem $ -*-text-*-
+
+
+**** 0.79 Aug 22, 2014
+
+Feature rt.cpan.org #98149
+
+ Add support for Android platform.
+
+Fix rt.cpan.org #97736
+
+ Net::DNS::Resolver->new mistakenly copies supplied arguments
+ into default configuration on first instantiation.
+
+Fix rt.cpan.org #97502
+
+ Net::DNS::Resolver->retrans does not accept a value of 1 (uses 2 instead)
+
+Fix rt.cpan.org #83642
+
+ Configure CD flag in Net::DNS::Resolver->new
+
+Fix rt.cpan.org #81760
+
+ Reverted workaround for TXT issue preventing propagation of
+ rule updates for SpamAssassin versions earlier than 3.4.0
+
+Fix rt.cpan.org #16630
+
+ Net::DNS::Resolver::Recurse issues lots of IMHO unnecessary DNS requests.
**** 0.78 Jul 10, 2014
@@ -2,6 +2,7 @@ Changes
contrib/check_soa
contrib/check_zone
contrib/dnswalk.README
+contrib/find_zonecut
contrib/loc2earth.fcgi
contrib/loclist.pl
contrib/README
@@ -26,6 +27,7 @@ lib/Net/DNS/Packet.pm
lib/Net/DNS/Parameters.pm
lib/Net/DNS/Question.pm
lib/Net/DNS/Resolver.pm
+lib/Net/DNS/Resolver/android.pm
lib/Net/DNS/Resolver/Base.pm
lib/Net/DNS/Resolver/cygwin.pm
lib/Net/DNS/Resolver/MSWin32.pm
@@ -63,6 +65,7 @@ lib/Net/DNS/RR/NAPTR.pm
lib/Net/DNS/RR/NID.pm
lib/Net/DNS/RR/NS.pm
lib/Net/DNS/RR/NULL.pm
+lib/Net/DNS/RR/OPENPGPKEY.pm
lib/Net/DNS/RR/OPT.pm
lib/Net/DNS/RR/PTR.pm
lib/Net/DNS/RR/PX.pm
@@ -43,5 +43,5 @@
}
},
"release_status" : "stable",
- "version" : "0.78"
+ "version" : "0.79"
}
@@ -25,4 +25,4 @@ requires:
MIME::Base64: 2.11
Test::More: 0.52
perl: 5.00404
-version: 0.78
+version: 0.79
@@ -9,11 +9,11 @@ check_soa Dick Franks <rwfranks@acm.org>
check_zone Dennis Glatting <dennis.glatting@software-munitions.com>
-dnswalk Dave Barr <barr@cis.ohio-state.edu>
+find_zonecut Dick Franks <rwfranks@acm.org>
loc2earth.fcgi Christopher Davis <ckd@kei.com>
loclist.pl Christopher Davis <ckd@kei.com>
---
-$Id: README 607 2006-09-17 18:20:28Z olaf $
+$Id: README 1251 2014-08-18 10:18:23Z willem $
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+$VERSION = (qw$LastChangedRevision: 1251 $)[1] || 0.01;
+
+=head1 NAME
+
+find_zonecut - Find zonecut for a domain name
+
+
+=head1 SYNOPSIS
+
+ find_zonecut name
+
+
+=head1 DESCRIPTION
+
+B<find_zonecut> returns the name of the closest delegation point
+to the specified domain name.
+
+=cut
+
+use strict;
+use Net::DNS;
+
+my $resolver = new Net::DNS::Resolver();
+
+print find_zonecut(shift), "\n";
+
+
+sub find_zonecut { ## Copyright (c)2014 Dick Franks
+ my $name = shift;
+ my $reply = $resolver->send( "*.$name", 'NULL' ) || die $resolver->errorstring;
+ my ($cut) = map $_->name, $reply->authority;
+ return $cut || die "failed to find zone cut for $name";
+}
+
+__END__
+
+
+=head1 COPYRIGHT
+
+(c)2014 Dick Franks E<lt>rwfranks[...]acm.orgE<gt>
+
+All rights reserved.
+
+This program is free software; you may use or redistribute
+it under the same terms as Perl itself.
+
+FOR DEMONSTRATION PURPOSES ONLY, NO WARRANTY, NO SUPPORT
+
+=head1 SEE ALSO
+
+L<perl>, L<Net::DNS>
+
+=cut
+
@@ -1,10 +1,10 @@
package Net::DNS::Header;
#
-# $Id: Header.pm 1101 2013-08-14 14:40:00Z willem $
+# $Id: Header.pm 1241 2014-08-11 13:13:59Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1101 $)[1];
+$VERSION = (qw$LastChangedRevision: 1241 $)[1];
=head1 NAME
@@ -125,7 +125,8 @@ A random value is assigned if the argument value is undefined.
sub id {
my $self = shift;
$$self->{id} = shift if scalar @_;
- $$self->{id} ||= int rand(0xffff);
+ return $$self->{id} if defined $$self->{id};
+ $$self->{id} = int rand(0xffff);
}
@@ -1,10 +1,10 @@
package Net::DNS::Packet;
#
-# $Id: Packet.pm 1225 2014-07-01 19:38:51Z willem $
+# $Id: Packet.pm 1246 2014-08-14 19:39:22Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1225 $)[1];
+$VERSION = (qw$LastChangedRevision: 1246 $)[1];
=head1 NAME
@@ -655,9 +655,10 @@ sub dn_expand_PP {
$query = Net::DNS::Packet->new( 'www.example.com', 'A' );
- $query->sign_tsig( 'Khmac-sha512.example.+165+01018.private',
- fudge => 60
- );
+ $query->sign_tsig(
+ 'Khmac-sha512.example.+165+01018.private',
+ fudge => 60
+ );
$reply = $res->send( $query );
@@ -675,15 +676,18 @@ must uniquely identify the key shared between the parties, and the
algorithm name must identify the signing function to be used with the
specified key.
- $tsig = Net::DNS::RR->new( name => 'tsig.example',
- type => 'TSIG',
- algorithm => 'custom-algorithm',
- sig_function => sub { ... },
- key => '<base64 key text>'
- );
+ $tsig = Net::DNS::RR->new(
+ name => 'tsig.example',
+ type => 'TSIG',
+ algorithm => 'custom-algorithm',
+ key => '<base64 key text>',
+ sig_function => sub {
+ my ($key, $data) = @_;
+ ...
+ }
+ );
- $packet = Net::DNS::Packet->new( 'www.example.com', 'A' );
- $packet->sign_tsig( $tsig );
+ $query->sign_tsig( $tsig );
The historical simplified syntax is still available, but additional
@@ -694,6 +698,7 @@ options can not be specified.
The response to an inbound request is signed by presenting the request
in place of the key parameter.
+
$response = $request->reply;
$response->sign_tsig( $request, @options );
@@ -709,7 +714,7 @@ The opaque intermediate object references returned during multi-packet
signing are not intended to be accessed by the end-user application.
Any such access is expressly forbidden.
-Note that a TSIG record is added to every packet; the implementation
+Note that a TSIG record is added to every packet; this implementation
does not support the suppressed signature scheme described in RFC2845.
=cut
@@ -1,16 +1,16 @@
package Net::DNS::Parameters;
#
-# $Id: Parameters.pm 1222 2014-06-24 12:30:08Z willem $
+# $Id: Parameters.pm 1246 2014-08-14 19:39:22Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1222 $)[1];
+$VERSION = (qw$LastChangedRevision: 1246 $)[1];
################################################
##
## Domain Name System (DNS) Parameters
-## (last updated 2014-06-16)
+## (last updated 2014-08-12)
##
################################################
@@ -104,6 +104,7 @@ use vars qw( %typebyname %typebyval );
TALINK => 58, #
CDS => 59, # RFC-ietf-dnsop-delegation-trust-maintainance-14
CDNSKEY => 60, # RFC-ietf-dnsop-delegation-trust-maintainance-14
+ OPENPGPKEY => 61, # draft-ietf-dane-openpgpkey
SPF => 99, # RFC7208
UINFO => 100, # IANA-Reserved
UID => 101, # IANA-Reserved
@@ -175,14 +176,14 @@ use vars qw( %rcodebyname %rcodebyval );
# Registry: DNS EDNS0 Option Codes (OPT)
use vars qw( %ednsoptionbyname %ednsoptionbyval );
%ednsoptionbyname = (
- LLQ => 1, # http://files.dns-sd.org/draft-sekar-dns-llq.txt
- UL => 2, # http://files.dns-sd.org/draft-sekar-dns-ul.txt
- NSID => 3, # RFC5001
- DAU => 5, # RFC6975
- DHU => 6, # RFC6975
- N3U => 7, # RFC6975
- 'EDNS-CLIENT-SUBNET' => 8, # draft-vandergaast-edns-client-subnet
- 'EDNS-EXPIRE' => 9, # RFC-andrews-dnsext-expire-04
+ LLQ => 1, # http://files.dns-sd.org/draft-sekar-dns-llq.txt
+ UL => 2, # http://files.dns-sd.org/draft-sekar-dns-ul.txt
+ NSID => 3, # RFC5001
+ DAU => 5, # RFC6975
+ DHU => 6, # RFC6975
+ N3U => 7, # RFC6975
+ 'CLIENT-SUBNET' => 8, # draft-vandergaast-edns-client-subnet
+ EXPIRE => 9, # RFC7314
);
%ednsoptionbyval = reverse %ednsoptionbyname;
%ednsoptionbyname = ( %ednsoptionbyname, map /\D/ ? lc($_) : $_, %ednsoptionbyname );
@@ -1,10 +1,10 @@
package Net::DNS::RR::AAAA;
#
-# $Id: AAAA.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: AAAA.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
use strict;
@@ -71,7 +71,7 @@ sub address {
return $self->address_long unless scalar @_;
- my $argument = shift;
+ my $argument = shift || '';
my @parse = split /:/, "0$argument";
if ( (@parse)[$#parse] =~ /\./ ) { # embedded IPv4
@@ -1,10 +1,10 @@
package Net::DNS::RR::MX;
#
-# $Id: MX.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: MX.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
use strict;
@@ -35,25 +35,25 @@ sub encode_rdata { ## encode rdata as wire-format octet string
my $self = shift;
my ( $offset, @opaque ) = @_;
- return '' unless $self->{exchange};
+ my $exchange = $self->{exchange} || return '';
my $rdata = pack 'n', $self->preference;
- $rdata .= $self->{exchange}->encode( $offset + length($rdata), @opaque );
+ $rdata .= $exchange->encode( $offset + length($rdata), @opaque );
}
sub format_rdata { ## format rdata portion of RR string.
my $self = shift;
- return '' unless $self->{exchange};
- join ' ', $self->preference, $self->{exchange}->string;
+ my $exchange = $self->{exchange} || return '';
+ join ' ', $self->preference, $exchange->string;
}
sub parse_rdata { ## populate RR from rdata in argument list
my $self = shift;
- $self->preference( shift || return );
- $self->exchange( shift || return );
+ $self->preference(shift) if @_;
+ $self->exchange( shift || return );
}
@@ -0,0 +1,127 @@
+package Net::DNS::RR::OPENPGPKEY;
+
+#
+# $Id: OPENPGPKEY.pm 1253 2014-08-19 13:18:09Z willem $
+#
+use vars qw($VERSION);
+$VERSION = (qw$LastChangedRevision: 1253 $)[1];
+
+
+use strict;
+use base qw(Net::DNS::RR);
+
+=head1 NAME
+
+Net::DNS::RR::OPENPGPKEY - DNS OPENPGPKEY resource record
+
+=cut
+
+
+use integer;
+
+use MIME::Base64;
+
+
+sub decode_rdata { ## decode rdata from wire-format octet string
+ my $self = shift;
+ my ( $data, $offset ) = @_;
+
+ my $length = $self->{rdlength};
+ $self->keysbin( substr $$data, $offset, $length );
+}
+
+
+sub encode_rdata { ## encode rdata as wire-format octet string
+ my $self = shift;
+
+ pack 'a*', $self->keysbin || '';
+}
+
+
+sub format_rdata { ## format rdata portion of RR string.
+ my $self = shift;
+
+ my $base64 = MIME::Base64::encode $self->keysbin || return '';
+ chomp $base64;
+ return "(\n$base64 )";
+}
+
+
+sub parse_rdata { ## populate RR from rdata in argument list
+ my $self = shift;
+
+ $self->keys(@_);
+}
+
+
+sub keys {
+ my $self = shift;
+
+ $self->keysbin( MIME::Base64::decode( join "", @_ ) ) if scalar @_;
+ return MIME::Base64::encode( $self->keysbin(), "" ) if defined wantarray;
+}
+
+
+sub keysbin {
+ my $self = shift;
+
+ $self->{keysbin} = shift if scalar @_;
+ $self->{keysbin} || "";
+}
+
+1;
+__END__
+
+
+=head1 SYNOPSIS
+
+ use Net::DNS;
+ $rr = new Net::DNS::RR('name OPENPGPKEY keys');
+
+=head1 DESCRIPTION
+
+Class for OpenPGP Key (OPENPGPKEY) resource records.
+
+=head1 METHODS
+
+The available methods are those inherited from the base class augmented
+by the type-specific methods defined in this package.
+
+Use of undocumented package features or direct access to internal data
+structures is discouraged and could result in program termination or
+other unpredictable behaviour.
+
+
+=head2 keys
+
+ $keys = $rr->keys;
+ $rr->keys( $keys );
+
+Base64 encoded representation of the binary OpenPGP public key material.
+
+=head2 keysbin
+
+ $keysbin = $rr->keysbin;
+ $rr->keysbin( $keysbin );
+
+Binary representation of the public key material.
+The key material is a simple concatenation of OpenPGP keys in RFC4880 format.
+
+
+=head1 COPYRIGHT
+
+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.
+
+Package template (c)2009,2012 O.M.Kolkman and R.W.Franks.
+
+
+=head1 SEE ALSO
+
+L<perl>, L<Net::DNS>, L<Net::DNS::RR>, draft-ietf-dane-openpgpkey
+
+=cut
@@ -1,10 +1,10 @@
package Net::DNS::RR::TXT;
#
-# $Id: TXT.pm 1229 2014-07-09 07:07:42Z willem $
+# $Id: TXT.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1229 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
use strict;
@@ -93,21 +93,6 @@ sub txtdata {
sub char_str_list { return (&txtdata); }
-
-sub rdatastr { ## SpamAssassin workaround, per CPAN RT#81760
- my $txtdata = shift->{txtdata} || [];
- join ' ', map $_->quoted_string, @$txtdata;
-}
-
-package Net::DNS::Text;
-
-sub quoted_string {
- my $string = shift->string;
- return $string if $string =~ /^"/; # string already quoted
- $string =~ s/\\([$();@])/$1/g; # nothing special within quotes
- join '', '"', $string, '"'; # quote previously unquoted string
-}
-
1;
__END__
@@ -1,10 +1,10 @@
package Net::DNS::RR;
#
-# $Id: RR.pm 1225 2014-07-01 19:38:51Z willem $
+# $Id: RR.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1225 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
=head1 NAME
@@ -65,8 +65,8 @@ sub new {
scalar @_ > 2 ? &_new_hash : &_new_string;
} || do {
my $class = shift || __PACKAGE__;
- my @parse = split /\s+/, shift || '';
- croak join ' ', "$@in new $class(", substr( "@parse @_", 0, 50 ), '... )';
+ my @param = map { !defined($_) ? 'undef': split; } @_;
+ croak join ' ', "$@in new $class(", substr( "@param", 0, 50 ), '... )';
};
}
@@ -95,7 +95,7 @@ The trailing dot (.) is optional.
=cut
-my $PARSE_REGEX = q/("[^"]*"|'[^']*')|;[^\n]*|[ \t\n\r\f()]/;
+my $PARSE_REGEX = q/("[^"]*")|;[^\n]*|[ \t\n\r\f()]/;
sub _new_string {
my $base;
@@ -105,8 +105,7 @@ sub _new_string {
# parse into quoted strings, contiguous non-whitespace and (discarded) comments
s/\\\\/\\092/g; # disguise escaped escape
- s/\\"/\\034/g; # disguise escaped double quote
- s/\\'/\\039/g; # disguise escaped single quote
+ s/\\"/\\034/g; # disguise escaped quote
s/\\\(/\\040/g; # disguise escaped bracket
s/\\\)/\\041/g; # disguise escaped bracket
s/\\;/\\059/g; # disguise escaped semicolon
@@ -354,6 +353,47 @@ sub canonical {
}
+=head2 print
+
+ $rr->print;
+
+Prints the record to the standard output. Calls the B<string>
+method to get the RR string representation.
+
+=cut
+
+sub print {
+ print shift->string, "\n";
+}
+
+
+=head2 string
+
+ print $rr->string, "\n";
+
+Returns a string representation of the RR using the zone file format
+described in RFC1035. All domain names are fully qualified with
+trailing dot. This differs from RR attribute methods, which omit
+the trailing dot.
+
+=cut
+
+sub string {
+ my $self = shift;
+
+ my $name = $self->name if COMPATIBLE;
+ my @core = ( $self->{owner}->string, $self->ttl, $self->class, $self->type );
+
+ my $rdata = $self->rdstring;
+
+ return join "\t", @core, '; no data' unless length $rdata;
+
+ chomp $rdata;
+ $rdata =~ s/\n+/\n\t/g;
+ return join "\t", @core, $rdata;
+}
+
+
=head2 owner name
$owner = $rr->name;
@@ -467,47 +507,6 @@ sub rdata {
}
-=head2 print
-
- $rr->print;
-
-Prints the record to the standard output. Calls the B<string>
-method to get the RR string representation.
-
-=cut
-
-sub print {
- print shift->string, "\n";
-}
-
-
-=head2 string
-
- print $rr->string, "\n";
-
-Returns a string representation of the RR using the zone file format
-described in RFC1035. All domain names are fully qualified with
-trailing dot. This differs from RR attribute methods, which omit
-the trailing dot.
-
-=cut
-
-sub string {
- my $self = shift;
-
- my $name = $self->name if COMPATIBLE;
- my @core = ( $self->{owner}->string, $self->ttl, $self->class, $self->type );
-
- my $rdata = $self->rdstring;
-
- return join "\t", @core, '; no data' unless length $rdata;
-
- chomp $rdata;
- $rdata =~ s/\n+/\n\t/g;
- return join "\t", @core, $rdata;
-}
-
-
=head2 rdstring
$rdstring = $rr->rdstring;
@@ -553,16 +552,15 @@ Returns a token list representation of the RR zone file string.
=cut
sub token {
- my $self = shift;
+ local $_ = shift->string;
- my @core = ( $self->{owner}->string, $self->ttl, $self->class, $self->type );
- local $_ = $self->rdstring;
+ # parse into quoted strings, contiguous non-whitespace and (discarded) comments
s/\\\\/\\092/g; # disguise escaped escape
- s/\\"/\\034/g; # disguise escaped double quote
- s/\\'/\\039/g; # disguise escaped single quote
+ s/\\"/\\034/g; # disguise escaped quote
+ s/\\\(/\\040/g; # disguise escaped bracket
+ s/\\\)/\\041/g; # disguise escaped bracket
s/\\;/\\059/g; # disguise escaped semicolon
- my @parse = grep defined && length, split /$PARSE_REGEX/o;
- my @token = @core, grep !/^[()]$/, @parse; # discard brackets
+ my @token = grep defined && length, split /$PARSE_REGEX/o;
}
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::Base;
#
-# $Id: Base.pm 1224 2014-07-01 07:57:42Z willem $
+# $Id: Base.pm 1252 2014-08-19 13:14:41Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1224 $)[1];
+$VERSION = (qw$LastChangedRevision: 1252 $)[1];
use strict;
@@ -22,6 +22,10 @@ use constant DNSSEC => eval { require Net::DNS::RR::DS; } || 0;
use constant INT16SZ => 2;
use constant PACKETSZ => 512;
+use constant UTIL => eval { require Scalar::Util; } || 0;
+sub tainted { return UTIL ? Scalar::Util::tainted(shift) : undef }
+sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
+
#
# A few implementation notes wrt IPv6 support.
@@ -92,9 +96,9 @@ BEGIN {
persistent_tcp => 0,
persistent_udp => 0,
dnssec => 0,
- udppacketsize => 0, # value bounded below by PACKETSZ
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
prefer_v6 => 0, # prefer v6, otherwise prefer v4
ignqrid => 0, # normally packets with non-matching ID
@@ -141,6 +145,7 @@ my %public_attr = map { $_ => 1 } qw(
persistent_tcp
persistent_udp
dnssec
+ cdflag
prefer_v6
ignqrid
);
@@ -159,10 +164,20 @@ sub new {
if ( my $file = $args{'config_file'} ) {
$self = bless {%$initial}, $class;
$self->read_config_file($file); # user specified config
- $self->$_( map /^(.+)$/ ? $1 : (), $self->$_ ) # untaint config values
- for (qw(nameservers domain searchlist));
+ $self->nameservers( _untaint $self->nameservers );
+ my @searchlist = _untaint $base->searchlist;
+ $base->searchlist( _untaint $base->domain || () ) unless @searchlist;
+ $base->domain(@searchlist) unless $base->domain;
+ %$base = %$self unless $init; # define default configuration
+
+ } elsif ($init) {
+ $self = bless {%$base}, $class;
+
} else {
- $class->init() unless $init; # system-wide config
+ $class->init(); # define default configuration
+ my @searchlist = $base->searchlist;
+ $base->searchlist( $base->domain || () ) unless @searchlist;
+ $base->domain(@searchlist) unless $base->domain;
$self = bless {%$base}, $class;
}
@@ -173,20 +188,12 @@ sub new {
croak "usage: Net::DNS::Resolver->new( $attr => [ ... ] )"
unless UNIVERSAL::isa( $value, 'ARRAY' );
- }
-
- if ( $attr eq 'nameservers' ) {
- $self->nameservers(@$value);
+ $self->$attr(@$value);
} else {
- $self->{$attr} = $value;
+ $self->$attr($value); # attribute => value
}
}
- return $self if $init;
- # define default configuration
- $self->searchlist( $self->domain || () ) unless @{$self->{searchlist}};
- $self->domain( $self->searchlist ) unless $self->{domain};
- %$base = %$self;
return $self;
}
@@ -235,9 +242,9 @@ sub read_config_file {
local *FILE;
open( FILE, $file ) or croak "Could not open $file: $!";
- local $/ = "\n";
- local $_;
+ local $SIG{__WARN__} = sub { die @_ };
+ local $_;
while (<FILE>) {
s/[;#].*$//; # strip comments
@@ -269,7 +276,7 @@ sub read_config_file {
};
}
- close FILE || croak "Could not close $file: $!";
+ close(FILE) || croak "close $file: $!";
$config->nameservers(@ns);
}
@@ -327,11 +334,11 @@ sub nameservers {
do { push @ipv6, $ns; next } if _ip_is_ipv6($ns);
do { push @ipv4, $ns; next } if _ip_is_ipv4($ns);
- my $defres = Net::DNS::Resolver->new(
+ my $defres = ref($self)->new(
udp_timeout => $self->udp_timeout,
- tcp_timeout => $self->tcp_timeout
- );
- $defres->{debug} = $self->{debug};
+ tcp_timeout => $self->tcp_timeout,
+ debug => $self->{debug} );
+ $defres->{cache} = $self->{cache} if $self->{cache};
my @names;
if ( $ns =~ /\./ ) {
@@ -354,6 +361,7 @@ sub nameservers {
my %address = map { $_ => $_ } @address; # tainted
my @unique = values %address;
+ carp "unresolvable name: $ns" unless @unique;
push @ipv4, grep _ip_is_ipv4($_), @unique;
push @ipv6, grep _ip_is_ipv6($_), @unique;
}
@@ -525,12 +533,11 @@ sub send_tcp {
NAMESERVER: foreach my $ns (@ns) {
-
- print ";; attempt to send_tcp [$ns]:$dstport (src port = $srcport)\n"
- if $self->{'debug'};
my $sock;
my $sock_key = "$ns:$dstport";
- my ( $host, $port );
+
+ print ";; send_tcp [$ns]:$dstport (src port = $srcport)\n" if $self->{'debug'};
+
if ( $self->persistent_tcp && $self->{'sockets'}[AF_UNSPEC]{$sock_key} ) {
$sock = $self->{'sockets'}[AF_UNSPEC]{$sock_key};
print ";; using persistent socket\n"
@@ -676,7 +683,7 @@ sub send_udp {
my $srcaddr6 = $srcaddr eq '0.0.0.0' ? '::' : $srcaddr;
- print ";; setting up an AF_INET6 UDP socket with srcaddr [$srcaddr6] ... "
+ print ";; setting up AF_INET6 UDP socket with srcaddr [$srcaddr6] ... "
if $self->{'debug'};
# IO::Socket carps on errors if Perl's -w flag is turned on.
@@ -696,10 +703,10 @@ sub send_udp {
}
# Always set up an AF_INET socket.
- # It will be used if the address family of for the endpoint is V4.
+ # It will be used if the address family of the endpoint is V4.
unless ( defined( $sock[AF_INET] ) ) {
- print ";; setting up an AF_INET UDP socket with srcaddr [$srcaddr] ... "
+ print ";; setting up AF_INET UDP socket with srcaddr [$srcaddr] ... "
if $self->{'debug'};
#my $old_wflag = $^W;
@@ -737,8 +744,8 @@ NSADDRESS: foreach my $ns_address ( $self->nameservers() ) {
# The logic below determines the $dst_sockaddr.
# If getaddrinfo is available that is used for both INET4 and INET6
- # If getaddrinfo is not avialable (Socket6 failed to load) we revert
- # to the 'classic mechanism
+ # If getaddrinfo is not available (Socket6 failed to load) we revert
+ # to the 'classic' mechanism
if ( $has_inet6 && !$self->force_v4() ) {
# we can use getaddrinfo
@@ -785,16 +792,16 @@ NSADDRESS: foreach my $ns_address ( $self->nameservers() ) {
$sel->add( $sock[AF_INET6()] ) if $has_inet6 && defined( $sock[AF_INET6()] ) && !$self->force_v4();
# Perform each round of retries.
- for ( my $i = 0 ;
- $i < $self->{'retry'} ;
- ++$i, $retrans *= 2, $timeout = int( $retrans / ( @ns || 1 ) )
- ) {
+ for ( my $i = 0 ; $i < $self->{'retry'} ; ++$i, $retrans *= 2 ) {
- $timeout = 1 if ( $timeout < 1 );
+ $timeout = int( $retrans / ( scalar @ns || 1 ) );
+ $timeout = 1 if $timeout < 1;
# Try each nameserver.
NAMESERVER: foreach my $ns (@ns) {
- next if defined $ns->[3];
+ my ( $nsname, $nsaddr, $nssockfamily, $err ) = @$ns;
+ next if defined $err;
+
if ($stop_time) {
my $now = time;
if ( $stop_time < $now ) {
@@ -805,9 +812,6 @@ NAMESERVER: foreach my $ns (@ns) {
$timeout = $stop_time - $now;
}
}
- my $nsname = $ns->[0];
- my $nsaddr = $ns->[1];
- my $nssockfamily = $ns->[2];
# If we do not have a socket for the transport
# we are supposed to reach the namserver on we
@@ -829,20 +833,22 @@ NAMESERVER: foreach my $ns (@ns) {
next NAMESERVER;
}
- print ";; send_udp [$nsname]:$dstport\n"
- if $self->{'debug'};
+ print ";; send_udp [$nsname]:$dstport\n" if $self->{'debug'};
unless ( $sock[$nssockfamily]->send( $packet_data, 0, $nsaddr ) ) {
- print ";; send error: $!\n" if $self->{'debug'};
- $self->errorstring("Send error: $!");
+ my $err = $ns->[3] = $self->errorstring("Send error: $!");
+ print ";; $err\n" if $self->{'debug'};
$nmbrnsfailed++;
- $ns->[3] = "Send error" . $self->errorstring();
next;
}
- # See ticket 11931 but this works not quite yet
- my $oldpacket_timeout = time + $timeout;
- until ( $oldpacket_timeout && ( $oldpacket_timeout < time() ) ) {
+ # handle failure to detect taint inside socket->send()
+ die 'Insecure dependency while running with -T switch' if tainted($nsaddr);
+
+
+ # See tickets #11931 and #97502
+ my $time_limit = time + $timeout;
+ while ( time() < $time_limit ) {
my @ready = $sel->can_read($timeout);
SELECTOR: foreach my $ready (@ready) {
my $buf = '';
@@ -913,8 +919,7 @@ NAMESERVER: foreach my $ns (@ns) {
if ( $sel->handles ) {
- # If there are valid handles than we have either a timeout or
- # a send error.
+ # If there are valid handles then we have either a timeout or a send error.
$self->errorstring('query timed out') unless ( $self->errorstring =~ /Send error:/ );
} else {
if ( $nmbrnsfailed < @ns ) {
@@ -1022,6 +1027,9 @@ sub bgsend {
$self->errorstring("Send: [$ns_address]:$dstport $!");
print ";; ", $self->errorstring(), "\n" if $self->{'debug'};
}
+
+ # handle failure to detect taint inside socket->send()
+ die 'Insecure dependency while running with -T switch' if tainted($dst_sockaddr);
return $socket;
}
$self->errorstring("Could not find a socket to send on");
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::MSWin32;
#
-# $Id: MSWin32.pm 1225 2014-07-01 19:38:51Z willem $
+# $Id: MSWin32.pm 1244 2014-08-12 22:10:45Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1225 $)[1];
+$VERSION = (qw$LastChangedRevision: 1244 $)[1];
=head1 NAME
@@ -17,7 +17,6 @@ use strict;
use base qw(Net::DNS::Resolver::Base);
use Carp;
-use Data::Dumper;
BEGIN {
use vars qw($Registry);
@@ -36,32 +35,29 @@ BEGIN {
}
-sub init {
+sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
- my $debug = 0;
- my ($class) = @_;
- my $defaults = $class->defaults;
+sub init {
+ my $defaults = shift->defaults;
+ my $debug = 0;
my $FIXED_INFO = {};
- my $ret = Win32::IPHelper::GetNetworkParams($FIXED_INFO);
-
- if ( $ret == 0 ) {
- print Dumper $FIXED_INFO if $debug;
- } else {
+ if ( my $ret = Win32::IPHelper::GetNetworkParams($FIXED_INFO) ) {
Carp::croak "GetNetworkParams() error %u: %s\n", $ret, Win32::FormatMessage($ret);
+ } elsif ($debug) {
+ require Data::Dumper;
+ print Data::Dumper::Dumper $FIXED_INFO;
}
my @nameservers = map { $_->{IpAddress} } @{$FIXED_INFO->{DnsServersList}};
- $defaults->nameservers(@nameservers) if scalar @nameservers;
-
- my $domain = $FIXED_INFO->{DomainName} || '';
- my $searchlist = $domain;
- $defaults->{domain} = $domain if $domain;
+ $defaults->nameservers( _untaint @nameservers );
+ my @searchlist = _untaint lc $FIXED_INFO->{DomainName};
+ $defaults->domain(@searchlist);
my $usedevolution = 0;
@@ -81,39 +77,37 @@ sub init {
}
if ( defined $reg_tcpip ) {
- $searchlist .= ',' if $searchlist; # $domain already in there
- $searchlist .= ( $reg_tcpip->GetValue('SearchList') || "" );
+ my $searchlist = lc $reg_tcpip->GetValue('SearchList') || '';
+ push @searchlist, split m/[\s,]+/, $searchlist;
+
my ( $value, $type ) = $reg_tcpip->GetValue('UseDomainNameDevolution');
$usedevolution = defined $value && $type == REG_DWORD ? hex $value : 0;
}
}
- 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,]+/, lc $searchlist ) ) {
- push( @a, $entry ) unless $h{$entry}++;
+ # fix devolution if configured, and simultaneously
+ # make sure no dups (but keep the order)
+ my @a;
+ my %h;
+ foreach my $entry (@searchlist) {
+ push( @a, $entry ) unless $h{$entry}++;
- if ($usedevolution) {
+ if ($usedevolution) {
- # 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( @a, $entry ) unless $h{$entry}++;
}
}
- $defaults->{searchlist} = [@a];
}
+ $defaults->searchlist( _untaint @a );
-
- $class->read_env;
+ $defaults->read_env;
}
+
1;
__END__
@@ -1,16 +1,32 @@
package Net::DNS::Resolver::Recurse;
#
-# $Id: Recurse.pm 1185 2014-04-03 09:21:21Z willem $
+# $Id: Recurse.pm 1252 2014-08-19 13:14:41Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1185 $)[1];
+$VERSION = (qw$LastChangedRevision: 1252 $)[1];
=head1 NAME
Net::DNS::Resolver::Recurse - Perform recursive DNS lookups
+
+=head1 SYNOPSIS
+
+ use Net::DNS::Resolver::Recurse;
+
+ $resolver = new Net::DNS::Resolver::Recurse();
+
+ $packet = $resolver->query ( 'www.example.com', 'A' );
+ $packet = $resolver->search( 'www.example.com', 'A' );
+ $packet = $resolver->send ( 'www.example.com', 'A' );
+
+
+=head1 DESCRIPTION
+
+This module is a subclass of Net::DNS::Resolver.
+
=cut
@@ -18,441 +34,232 @@ use strict;
use base qw(Net::DNS::Resolver);
-my %hardcodedhints
- = ( 'a.root-servers.net' => ['198.41.0.4' , '2001:503:ba3e::2:30' ]
- , 'b.root-servers.net' => ['192.228.79.201']
- , 'c.root-servers.net' => ['192.33.4.12' ]
- , 'd.root-servers.net' => ['128.8.10.90' , '2001:500:2d::d' ]
- , 'e.root-servers.net' => ['192.203.230.10']
- , 'f.root-servers.net' => ['192.5.5.241' , '2001:500:2f::f' ]
- , 'g.root-servers.net' => ['192.112.36.4' ]
- , 'h.root-servers.net' => ['128.63.2.53' , '2001:500:1::803f:235']
- , 'i.root-servers.net' => ['192.36.148.17' , '2001:7fe::53' ]
- , 'j.root-servers.net' => ['192.58.128.30' , '2001:503:c27::2:30' ]
- , 'k.root-servers.net' => ['193.0.14.129' , '2001:7fd::1' ]
- , 'l.root-servers.net' => ['199.7.83.42' , '2001:500:3::42' ]
- , 'm.root-servers.net' => ['202.12.27.33' , '2001:dc3::35' ]
- );
+=head1 METHODS
-sub hints {
- my $self = shift;
- my @hints = @_;
- print ";; hints(@hints)\n" if $self->{'debug'};
-
- if (!@hints && !$self->nameservers){
- return $self->hints( map { @{ $_ } } values %hardcodedhints )
- }elsif (!@hints && $self->nameservers) {
- return $self->hints($self->nameservers);
- } else {
- $self->nameservers(@hints);
- }
-
- print ";; verifying (root) zone...\n" if $self->{'debug'};
- # bind always asks one of the hint servers
- # for who it thinks is authoritative for
- # the (root) zone as a sanity check.
- # Nice idea.
-
- $self->recurse(1);
- my $packet=$self->query(".", "NS", "IN");
- $self->recurse(0);
- my %hints = ();
- if ($packet) {
- if (my @ans = $packet->answer) {
- foreach my $rr (@ans) {
- if ($rr->name =~ /^\.?$/ and
- $rr->type eq "NS") {
- # Found root authority
- my $server = lc $rr->rdatastr;
- $server =~ s/\.$//;
- print ";; FOUND HINT: $server\n" if $self->{'debug'};
- $hints{$server} = [];
- }
- }
- foreach my $rr ($packet->additional) {
- print ";; ADDITIONAL: ",$rr->string,"\n" if $self->{'debug'};
- if (my $server = lc $rr->name){
- if ( $rr->type eq "A") {
- #print ";; ADDITIONAL HELP: $server -> [".$rr->rdatastr."]\n" if $self->{'debug'};
- if ($hints{$server}) {
- print ";; STORING IP: $server IN A ",$rr->rdatastr,"\n" if $self->{'debug'};
- push @{ $hints{$server} }, $rr->rdatastr;
- }
- }
- if ( $rr->type eq "AAAA") {
- #print ";; ADDITIONAL HELP: $server -> [".$rr->rdatastr."]\n" if $self->{'debug'};
- if ($hints{$server}) {
- print ";; STORING IP6: $server IN AAAA ",$rr->rdatastr,"\n" if $self->{'debug'};
- push @{ $hints{$server} }, $rr->rdatastr;
- }
- }
+This module inherits almost all the methods from Net::DNS::Resolver.
+Additional module-specific methods are described below.
- }
- }
- }
- foreach my $server (keys %hints) {
- if (!@{ $hints{$server} }) {
- if (exists $hardcodedhints{ lc $server }) {
- # Not all root servers provide glue and we know the answers.
- $hints{$server} = $hardcodedhints{ lc $server };
- } else {
- # Wipe the servers without lookups
- delete $hints{$server};
- }
- }
- }
- $self->{'hints'} = \%hints;
- } else {
- $self->{'hints'} = {};
- }
- if (%{ $self->{'hints'} }) {
- if ($self->{'debug'}) {
- print ";; USING THE FOLLOWING HINT IPS:\n";
- foreach my $ips (values %{ $self->{'hints'} }) {
- foreach my $server (@{ $ips }) {
- print ";; $server\n";
- }
- }
- }
- } else {
- warn "Servers [". join " ",($self->nameservers),"] did not give answers";
- print ";; Unsetting hints and nameservers, trying with hardcoded nameservers\n" if $self->{'debug'};
- print $self->empty_nameservers();
- return $self->hints();
- }
- # Disable recursion flag.
+=head2 hints
+
+This method specifies a list of the IP addresses used to locate
+the authoritative name servers for the root (.) zone.
+
+ $resolver->hints(@ip);
+If no hints are passed, the default nameserver is used to discover
+the addresses of the root nameservers.
+
+If the default nameserver not been configured correctly,
+or at all, a built-in list of IP addresses is used.
+
+=cut
+
+my @hints;
+my $root;
+
+sub hints {
+ my $self = shift;
- return $self->nameservers( map { @{ $_ } } values %{ $self->{'hints'} } );
+ @hints = @_ if scalar @_;
+ return @hints;
}
-sub recursion_callback {
- my ($self, $sub) = @_;
+=head2 query, search, send
- if ($sub && UNIVERSAL::isa($sub, 'CODE')) {
- $self->{'callback'} = $sub;
+The query(), search() and send() methods produce the same result
+as their counterparts in Net::DNS::Resolver.
+
+ $packet = $resolver->send( 'www.example.com.', 'A' );
+
+Server-side recursion is suppressed by clearing the recurse flag
+in the packet and recursive name resolution is performed explicitly.
+
+The query() and search() methods are inherited from Net::DNS::Resolver
+and invoke send() indirectly.
+
+=cut
+
+sub send {
+ return &Net::DNS::Resolver::Base::send if ref $_[1]; # send Net::DNS::Packet
+
+ my $self = shift;
+ my $res = bless {cache => {}, %$self}, ref($self); # Note: cache discarded after query
+
+ my $question = new Net::DNS::Question(@_);
+ my $original = pop(@_); # sneaky extra argument needed
+ $original = $question unless ref($original); # to preserve original request
+
+ my ( $head, @tail ) = $question->{owner}->label;
+ unless ($head) {
+ return $root if $root; # root servers cached indefinitely
+
+ my $defres = new Net::DNS::Resolver();
+ $defres->nameservers( $res->hints ) || $defres->nameservers( $res->_hints );
+
+ my $packet = $defres->send( '.', 'NS' ); # specified hint server
+ $res->{callback}->($packet) if $res->{callback};
+ my @auth = grep $_->type eq 'NS', $packet->answer, $packet->authority;
+ my %auth = map { lc $_->nsdname => 1 } @auth;
+ my @glue = grep $auth{lc $_->name}, $packet->additional;
+ my %glue;
+ foreach ( grep $_->type eq 'A', @glue ) { push @{$glue{lc $_->name}}, $_->address }
+ foreach ( grep $_->type eq 'AAAA', @glue ) { push @{$glue{lc $_->name}}, $_->address }
+ my @ip = map @$_, values %glue;
+ return $root = $packet if @ip && $packet->header->aa;
+
+ $defres->nameservers(@ip);
+ $defres->recurse(0);
+ foreach my $ns ( map $_->nsdname, @auth ) {
+ $defres->nameservers($ns) unless @ip;
+ $packet = $defres->send( '.', 'NS' ); # authoritative root server
+ $res->{callback}->($packet) if $res->{callback};
+ my @auth = grep $_->type eq 'NS', $packet->answer, $packet->authority;
+ my %auth = map { lc $_->nsdname => 1 } @auth;
+ my @glue = grep $auth{lc $_->name}, $packet->additional;
+ my @ip = grep $_->type eq 'A', @glue;
+ push @ip, grep $_->type eq 'AAAA', @glue;
+ return $root = $packet if @ip && @auth;
+ }
+ return $packet;
}
- return $self->{'callback'};
-}
+ my $domain = $question->qtype ne 'NULL' ? $original->qname : join '.', @tail;
+ my $nslist = $res->{cache}->{$domain} ||= [];
+ if ( scalar @$nslist ) {
+ print ";; using cached nameservers for $domain.\n" if $res->{debug};
+ } else {
+ my $packet = $res->send( $domain, 'NULL', 'ANY', $original ) || return;
+ return $packet unless $packet->header->rcode eq 'NOERROR';
+ my @answer = $packet->answer; # return authoritative answer
+ return $packet if $packet->header->aa && grep $_->name eq $original->qname, @answer;
-# $res->query_dorecursion( args );
-# Takes same args as Net::DNS::Resolver->query
-# Purpose: Do that "hot pototo dance" on args.
-sub query_dorecursion {
- my $self = shift;
- my @query = @_;
+ my @auth = grep $_->type eq 'NS', $packet->answer, $packet->authority;
+ print ";; cache nameservers for $domain.\n" if $res->{debug} && scalar(@auth);
+ my %auth = map { lc $_->nsdname => 1 } @auth;
+ my @glue = grep $auth{lc $_->name}, $packet->additional;
- # Make sure the hint servers are initialized.
- $self->hints unless $self->{'hints'};
- $self->recurse(0);
- # Make sure the authority cache is clean.
- # It is only used to store A and AAAA records of
- # the suposedly authoritative name servers.
- $self->{'authority_cache'} = {};
+ my %glue;
+ foreach ( grep $_->type eq 'A', @glue ) { push @{$glue{lc $_->name}}, $_->address }
+ foreach ( grep $_->type eq 'AAAA', @glue ) { push @{$glue{lc $_->name}}, $_->address }
+ @$nslist = values %glue;
- # Obtain real question Net::DNS::Packet
- my $query_packet = $self->make_query_packet(@query);
+ my @noglue = grep !$glue{$_}, keys %auth;
+ push @$nslist, @noglue;
+ }
- # Seed name servers with hints
- return $self->_dorecursion( $query_packet, ".", $self->{'hints'}, 0);
-}
+ my $query = new Net::DNS::Packet();
+ $query->push( question => $original );
+ $res->recurse(0);
-sub _dorecursion {
- my $self = shift;
- my $query_packet = shift;
- my $known_zone = shift;
- my $known_authorities = shift;
- my $depth = shift;
- my $cache = $self->{'authority_cache'};
-
- # die "Recursion too deep, aborting..." if $depth > 255;
- if ( $depth > 255 ) {
- print ";; _dorecursion() Recursion too deep, aborting...\n" if
- $self->{'debug'};
- $self->errorstring("Recursion too deep, abborted");
- return undef;
- }
-
- $known_zone =~ s/\.*$/./;
-
- # Get IPs from authorities
- my @ns = ();
- foreach my $ns (keys %{ $known_authorities }) {
- if (scalar @{ $known_authorities->{$ns} }) {
- $cache->{$ns} = $known_authorities->{$ns};
- push (@ns, @{ $cache->{$ns} });
- } elsif ($cache->{$ns}) {
- $known_authorities->{$ns} = $cache->{$ns};
- push (@ns, @{ $cache->{$ns} });
- }
- }
-
- if (!@ns) {
- my $found_auth = 0;
- if ($self->{'debug'}) {
- require Data::Dumper;
- print ";; _dorecursion() Failed to extract nameserver IPs:\n";
- print Data::Dumper::Dumper([$known_authorities,$cache]);
- }
- foreach my $ns (keys %{ $known_authorities }) {
- if (!@{ $known_authorities->{$ns} }) {
- print ";; _dorecursion() Manual lookup for authority [$ns]\n" if $self->{'debug'};
-
- my $auth_packet;
- my @ans;
-
- # Don't query for V6 if its not there.
- if ($Net::DNS::Resolver::Base::has_inet6 && ! $self->{force_v4}){
- $auth_packet =
- $self->_dorecursion
- ($self->make_query_packet($ns,"AAAA"), # packet
- ".", # known_zone
- $self->{'hints'}, # known_authorities
- $depth+1); # depth
- @ans = $auth_packet->answer if $auth_packet;
+ my @a = grep ref($_), @$nslist;
+ splice @a, 0, 0, splice( @a, int( rand scalar @a ) ); # cut deck
+
+ foreach (@a) {
+ $res->nameservers( map @$_, @a );
+ my $reply = $res->send($query) || last;
+ $res->{callback}->($reply) if $res->{callback};
+ return $reply;
}
- $auth_packet =
- $self->_dorecursion
- ($self->make_query_packet($ns,"A"), # packet
- ".", # known_zone
- $self->{'hints'}, # known_authorities
- $depth+1); # depth
-
- push (@ans,$auth_packet->answer ) if $auth_packet;
-
- if ( @ans ) {
- print ";; _dorecursion() Answers found for [$ns]\n" if $self->{'debug'};
- foreach my $rr (@ans) {
- print ";; RR:".$rr->string."\n" if $self->{'debug'};
- if ($rr->type eq "CNAME") {
- # Follow CNAME
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($server eq $ns) {
- my $cname = lc $rr->rdatastr;
- $cname =~ s/\.*$/./;
- print ";; _dorecursion() Following CNAME ns [$ns] -> [$cname]\n" if $self->{'debug'};
- $known_authorities->{$cname} ||= [];
- delete $known_authorities->{$ns};
- next;
- }
- }
- } elsif ($rr->type eq "A" ||$rr->type eq "AAAA" ) {
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($known_authorities->{$server}) {
- my $ip = $rr->rdatastr;
- print ";; _dorecursion() Found ns: $server IN A $ip\n" if $self->{'debug'};
- $cache->{$server} = $known_authorities->{$server};
- push (@{ $cache->{$ns} }, $ip);
- $found_auth++;
- next;
- }
- }
- }
- print ";; _dorecursion() Ignoring useless answer: ",$rr->string,"\n" if $self->{'debug'};
- }
- } else {
- print ";; _dorecursion() Could not find A records for [$ns]\n" if $self->{'debug'};
- }
- }
- }
- if ($found_auth) {
- print ";; _dorecursion() Found $found_auth new NS authorities...\n" if $self->{'debug'};
- return $self->_dorecursion( $query_packet, $known_zone, $known_authorities, $depth+1);
- }
- print ";; _dorecursion() No authority information could be obtained.\n" if $self->{'debug'};
- return undef;
- }
-
- # Cut the deck of IPs in a random place.
- print ";; _dorecursion() cutting deck of (".scalar(@ns).") authorities...\n" if $self->{'debug'};
- splice(@ns, 0, 0, splice(@ns, int(rand @ns)));
-
-
- LEVEL: foreach my $levelns (@ns){
- print ";; _dorecursion() Trying nameserver [$levelns]\n" if $self->{'debug'};
- $self->nameservers($levelns);
-
- if (my $packet = $self->send( $query_packet )) {
-
- if ($self->{'callback'}) {
- $self->{'callback'}->($packet);
- }
-
- my $of = undef;
- print ";; _dorecursion() Response received from [",$self->answerfrom,"]\n" if $self->{'debug'};
- if (my $status = $packet->header->rcode) {
- if ($status eq "NXDOMAIN") {
- # I guess NXDOMAIN is the best we'll ever get
- print ";; _dorecursion() returning NXDOMAIN\n" if $self->{'debug'};
- return $packet;
- } elsif (my @ans = $packet->answer) {
- print ";; _dorecursion() Answers were found.\n" if $self->{'debug'};
- return $packet;
- } elsif (my @authority = $packet->authority) {
- my %auth = ();
- foreach my $rr (@authority) {
- if ($rr->type =~ /^(NS|SOA)$/) {
- my $server = lc ($1 eq "NS" ? $rr->nsdname : $rr->mname);
- $server =~ s/\.*$/./;
- $of = lc $rr->name;
- $of =~ s/\.*$/./;
- print ";; _dorecursion() Received authority [$of] [",$rr->type(),"] [$server]\n" if $self->{'debug'};
- if (length $of <= length $known_zone) {
- print ";; _dorecursion() Deadbeat name server did not provide new information.\n" if $self->{'debug'};
- next LEVEL;
- } elsif ($of =~ /$known_zone$/) {
- print ";; _dorecursion() FOUND closer authority for [$of] at [$server].\n" if $self->{'debug'};
- $auth{$server} ||= [];
- } else {
- print ";; _dorecursion() Confused name server [",$self->answerfrom,"] thinks [$of] is closer than [$known_zone]?\n" if $self->{'debug'};
- last;
- }
- } else {
- print ";; _dorecursion() Ignoring NON NS entry found in authority section: ",$rr->string,"\n" if $self->{'debug'};
- }
- }
- foreach my $rr ($packet->additional) {
- if ($rr->type eq "CNAME") {
- # Store this CNAME into %auth too
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($auth{$server}) {
- my $cname = lc $rr->rdatastr;
- $cname =~ s/\.*$/./;
- print ";; _dorecursion() FOUND CNAME authority: ",$rr->string,"\n" if $self->{'debug'};
- $auth{$cname} ||= [];
- $auth{$server} = $auth{$cname};
- next;
- }
- }
- } elsif ($rr->type eq "A" || $rr->type eq "AAAA") {
- if (my $server = lc $rr->name) {
- $server =~ s/\.*$/./;
- if ($auth{$server}) {
- print ";; _dorecursion() STORING: $server IN A ",$rr->rdatastr,"\n" if $self->{'debug'} && $rr->type eq "A";
- print ";; _dorecursion() STORING: $server IN AAAA ",$rr->rdatastr,"\n" if $self->{'debug'}&& $rr->type eq "AAAA";
- push @{ $auth{$server} }, $rr->rdatastr;
- next;
- }
- }
- }
- print ";; _dorecursion() Ignoring useless: ",$rr->string,"\n" if $self->{'debug'};
- }
- if ($of =~ /$known_zone$/) {
- return $self->_dorecursion( $query_packet, $of, \%auth, $depth+1 );
- } else {
- return $self->_dorecursion( $query_packet, $known_zone, $known_authorities, $depth+1 );
- }
- }
- }
- }
- }
- # None of the authorities with IP worked. Are there still some without IP?
- foreach my $ns (keys %{ $known_authorities }) {
- if (scalar @{ $known_authorities->{$ns} }) {
- delete $known_authorities->{$ns};
- }
- }
- if (%{ $known_authorities }) {
- print ";; _dorecursion() None of the authorities with IP worked, "
- . "retry with the others...\n" if $self->{'debug'};
- return $self->_dorecursion( $query_packet
- , $known_zone
- , $known_authorities
- , $depth+1
- );
- }
- return undef;
+ foreach my $ns ( grep !ref($_), @$nslist ) {
+ 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
+ my $reply = $res->send($query) || next;
+ $res->{callback}->($reply) if $res->{callback};
+ return $reply;
+ }
+ return;
}
-1;
+sub query_dorecursion { &send; } ## historical
-__END__
+=head2 callback
-=head1 SYNOPSIS
+This method specifies a code reference to a subroutine,
+which is then invoked at each stage of the recursive lookup.
- use Net::DNS::Resolver::Recurse;
- my $res = Net::DNS::Resolver::Recurse->new;
+For example to emulate dig's C<+trace> function:
-=head1 DESCRIPTION
+ my $coderef = sub {
+ my $packet = shift;
-This module is a sub class of Net::DNS::Resolver.
+ $_->print for $packet->additional;
-=head1 METHODS
+ printf ";; Received %d bytes from %s\n\n",
+ $packet->answersize, $packet->answerfrom;
+ };
-This module inherits all the methods from Net::DNS::Resolver.
-The additional module-specific methods are described below.
+ $resolver->callback($coderef);
-=head2 hints
+The callback subroutine is not called
+for queries for missing glue records.
-Initialize the hint servers. Recursive queries need a starting name
-server to work from. This method takes a list of IP addresses to use
-as the starting servers. These name servers should be authoritative
-for the root (.) zone.
+=cut
- $res->hints(@ips);
+sub callback {
+ my ( $self, $sub ) = @_;
-If no hints are passed, the default nameserver is asked for the hints.
-Normally these IPs can be obtained from the following location:
+ $self->{callback} = $sub if $sub && UNIVERSAL::isa( $sub, 'CODE' );
+ return $self->{callback};
+}
- ftp://ftp.internic.net/domain/named.root
+sub recursion_callback { &callback; } ## historical
-=head2 recursion_callback
-This method is takes a code reference, which is then invoked each time a
-packet is received during the recursive lookup. For example to emulate
-dig's C<+trace> function:
+sub bgsend {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ Carp::croak "method ${class}::bgsend undefined";
+}
- $res->recursion_callback(sub {
- my $packet = shift;
- $_->print for $packet->additional;
+########################################
- printf(";; Received %d bytes from %s\n\n",
- $packet->answersize,
- $packet->answerfrom
- );
- });
+sub _hints { ## default hints
+ require Net::DNS::ZoneFile;
-=head2 query_dorecursion
+ my $dug = new Net::DNS::ZoneFile( \*DATA );
+ my @rr = $dug->read;
-This method is much like the normal query() method except it disables
-the recurse flag in the packet and explicitly performs the recursion.
+ my @auth = grep $_->type eq 'NS', @rr;
+ my %auth = map { lc $_->nsdname => 1 } @auth;
+ my @glue = grep $auth{lc $_->name}, @rr;
+ my %glue;
+ foreach ( grep $_->type eq 'A', @glue ) { push @{$glue{lc $_->name}}, $_->address }
+ foreach ( grep $_->type eq 'AAAA', @glue ) { push @{$glue{lc $_->name}}, $_->address }
+ my @ip = map @$_, values %glue;
+}
- $packet = $res->query_dorecursion( "www.netscape.com.", "A");
+1;
-=head1 IPv6 transport
-If the appropriate IPv6 libraries are installed the recursive resolver
-will randomly choose between IPv6 and IPv4 addresses of the
-nameservers it encounters during recursion.
+=head1 ACKNOWLEDGEMENT
-If you want to force IPv4 transport use the force_v4() method. Also see
-the IPv6 transport notes in the Net::DNS::Resolver documentation.
+This package is an improved and compatible reimplementation of the
+Net::DNS::Resolver::Recurse.pm created by Rob Brown in 2002.
-=head1 AUTHOR
+The contribution of Rob Brown is gratefully acknowledged.
-Rob Brown, bbb@cpan.org
=head1 COPYRIGHT
-Copyright (c)2002, Rob Brown.
+Copyright (c)2014 Dick Franks
-Portions Copyright (c)2005, Olaf M Kolkman.
+Portions Copyright (c)2002 Rob Brown
All rights reserved.
-This module is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
+This program is free software; you may redistribute it and/or
+modify it under the same terms as Perl itself.
+
=head1 SEE ALSO
@@ -460,75 +267,65 @@ L<Net::DNS::Resolver>
=cut
-Example lookup process:
-
-[root@box root]# dig +trace www.rob.com.au.
-
-; <<>> DiG 9.2.0 <<>> +trace www.rob.com.au.
-;; global options: printcmd
-. 507343 IN NS C.ROOT-SERVERS.NET.
-. 507343 IN NS D.ROOT-SERVERS.NET.
-. 507343 IN NS E.ROOT-SERVERS.NET.
-. 507343 IN NS F.ROOT-SERVERS.NET.
-. 507343 IN NS G.ROOT-SERVERS.NET.
-. 507343 IN NS H.ROOT-SERVERS.NET.
-. 507343 IN NS I.ROOT-SERVERS.NET.
-. 507343 IN NS J.ROOT-SERVERS.NET.
-. 507343 IN NS K.ROOT-SERVERS.NET.
-. 507343 IN NS L.ROOT-SERVERS.NET.
-. 507343 IN NS M.ROOT-SERVERS.NET.
-. 507343 IN NS A.ROOT-SERVERS.NET.
-. 507343 IN NS B.ROOT-SERVERS.NET.
-;; Received 436 bytes from 127.0.0.1#53(127.0.0.1) in 9 ms
- ;;; But these should be hard coded as the hints
-
- ;;; Ask H.ROOT-SERVERS.NET gave:
-au. 172800 IN NS NS2.BERKELEY.EDU.
-au. 172800 IN NS NS1.BERKELEY.EDU.
-au. 172800 IN NS NS.UU.NET.
-au. 172800 IN NS BOX2.AUNIC.NET.
-au. 172800 IN NS SEC1.APNIC.NET.
-au. 172800 IN NS SEC3.APNIC.NET.
-;; Received 300 bytes from 128.63.2.53#53(H.ROOT-SERVERS.NET) in 322 ms
- ;;; A little closer than before
-
- ;;; Ask NS2.BERKELEY.EDU gave:
-com.au. 259200 IN NS ns4.ausregistry.net.
-com.au. 259200 IN NS dns1.telstra.net.
-com.au. 259200 IN NS au2ld.CSIRO.au.
-com.au. 259200 IN NS audns01.syd.optus.net.
-com.au. 259200 IN NS ns.ripe.net.
-com.au. 259200 IN NS ns1.ausregistry.net.
-com.au. 259200 IN NS ns2.ausregistry.net.
-com.au. 259200 IN NS ns3.ausregistry.net.
-com.au. 259200 IN NS ns3.melbourneit.com.
-;; Received 387 bytes from 128.32.206.12#53(NS2.BERKELEY.EDU) in 10312 ms
- ;;; A little closer than before
-
- ;;; Ask ns4.ausregistry.net gave:
-com.au. 259200 IN NS ns1.ausregistry.net.
-com.au. 259200 IN NS ns2.ausregistry.net.
-com.au. 259200 IN NS ns3.ausregistry.net.
-com.au. 259200 IN NS ns4.ausregistry.net.
-com.au. 259200 IN NS ns3.melbourneit.com.
-com.au. 259200 IN NS dns1.telstra.net.
-com.au. 259200 IN NS au2ld.CSIRO.au.
-com.au. 259200 IN NS ns.ripe.net.
-com.au. 259200 IN NS audns01.syd.optus.net.
-;; Received 259 bytes from 137.39.1.3#53(ns4.ausregistry.net) in 606 ms
- ;;; Uh... yeah... I already knew this
- ;;; from what NS2.BERKELEY.EDU told me.
- ;;; ns4.ausregistry.net must have brain damage
-
- ;;; Ask ns1.ausregistry.net gave:
-rob.com.au. 86400 IN NS sy-dns02.tmns.net.au.
-rob.com.au. 86400 IN NS sy-dns01.tmns.net.au.
-;; Received 87 bytes from 203.18.56.41#53(ns1.ausregistry.net) in 372 ms
- ;;; Ah, much better. Something more useful.
-
- ;;; Ask sy-dns02.tmns.net.au gave:
-www.rob.com.au. 7200 IN A 139.134.5.123
-rob.com.au. 7200 IN NS sy-dns01.tmns.net.au.
-rob.com.au. 7200 IN NS sy-dns02.tmns.net.au.
-;; Received 135 bytes from 139.134.2.18#53(sy-dns02.tmns.net.au) in 525 ms
- ;;; FINALLY, THE ANSWER!
+
+__DATA__ ## DEFAULT HINTS
+
+; <<>> DiG 9.9.4-P2-RedHat-9.9.4-15.P2.fc20 <<>> @a.root-servers.net . -t NS
+; (2 servers found)
+;; global options: +cmd
+;; Got answer:
+;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 4589
+;; flags: qr aa rd; QUERY: 1, ANSWER: 13, AUTHORITY: 0, ADDITIONAL: 25
+;; WARNING: recursion requested but not available
+
+;; OPT PSEUDOSECTION:
+; EDNS: version: 0, flags:; udp: 4096
+;; QUESTION SECTION:
+;. IN NS
+
+;; ANSWER SECTION:
+. 518400 IN NS c.root-servers.net.
+. 518400 IN NS k.root-servers.net.
+. 518400 IN NS l.root-servers.net.
+. 518400 IN NS j.root-servers.net.
+. 518400 IN NS b.root-servers.net.
+. 518400 IN NS g.root-servers.net.
+. 518400 IN NS h.root-servers.net.
+. 518400 IN NS d.root-servers.net.
+. 518400 IN NS a.root-servers.net.
+. 518400 IN NS f.root-servers.net.
+. 518400 IN NS i.root-servers.net.
+. 518400 IN NS m.root-servers.net.
+. 518400 IN NS e.root-servers.net.
+
+;; ADDITIONAL SECTION:
+c.root-servers.net. 3600000 IN A 192.33.4.12
+c.root-servers.net. 3600000 IN AAAA 2001:500:2::c
+k.root-servers.net. 3600000 IN A 193.0.14.129
+k.root-servers.net. 3600000 IN AAAA 2001:7fd::1
+l.root-servers.net. 3600000 IN A 199.7.83.42
+l.root-servers.net. 3600000 IN AAAA 2001:500:3::42
+j.root-servers.net. 3600000 IN A 192.58.128.30
+j.root-servers.net. 3600000 IN AAAA 2001:503:c27::2:30
+b.root-servers.net. 3600000 IN A 192.228.79.201
+b.root-servers.net. 3600000 IN AAAA 2001:500:84::b
+g.root-servers.net. 3600000 IN A 192.112.36.4
+h.root-servers.net. 3600000 IN A 128.63.2.53
+h.root-servers.net. 3600000 IN AAAA 2001:500:1::803f:235
+d.root-servers.net. 3600000 IN A 199.7.91.13
+d.root-servers.net. 3600000 IN AAAA 2001:500:2d::d
+a.root-servers.net. 3600000 IN A 198.41.0.4
+a.root-servers.net. 3600000 IN AAAA 2001:503:ba3e::2:30
+f.root-servers.net. 3600000 IN A 192.5.5.241
+f.root-servers.net. 3600000 IN AAAA 2001:500:2f::f
+i.root-servers.net. 3600000 IN A 192.36.148.17
+i.root-servers.net. 3600000 IN AAAA 2001:7fe::53
+m.root-servers.net. 3600000 IN A 202.12.27.33
+m.root-servers.net. 3600000 IN AAAA 2001:dc3::35
+e.root-servers.net. 3600000 IN A 192.203.230.10
+
+;; Query time: 29 msec
+;; SERVER: 198.41.0.4#53(198.41.0.4)
+;; WHEN: Mon Aug 11 14:39:19 BST 2014
+;; MSG SIZE rcvd: 755
+
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::UNIX;
#
-# $Id: UNIX.pm 1224 2014-07-01 07:57:42Z willem $
+# $Id: UNIX.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1224 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
=head1 NAME
@@ -26,19 +26,24 @@ push( @config_path, $ENV{HOME} ) if exists $ENV{HOME};
push( @config_path, '.' );
+sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
+
+
sub init {
- my $self = shift->defaults;
+ my $defaults = shift->defaults;
+
+ $defaults->read_config_file($resolv_conf) if -f $resolv_conf && -r _;
- $self->read_config_file($resolv_conf) if -f $resolv_conf && -r _;
- $self->$_( map /^(.+)$/ ? $1 : (), $self->$_ ) # untaint config values
- for (qw(nameservers domain searchlist));
+ $defaults->domain( _untaint $defaults->domain ); # untaint config values
+ $defaults->searchlist( _untaint $defaults->searchlist );
+ $defaults->nameservers( _untaint $defaults->nameservers );
foreach my $dir (@config_path) {
my $file = "$dir/$dotfile";
- $self->read_config_file($file) if -f $file && -r _ && -o _;
+ $defaults->read_config_file($file) if -f $file && -r _ && -o _;
}
- $self->read_env;
+ $defaults->read_env;
}
@@ -0,0 +1,83 @@
+package Net::DNS::Resolver::android;
+
+#
+# $Id: android.pm 1255 2014-08-20 09:05:00Z willem $
+#
+use vars qw($VERSION);
+$VERSION = (qw$LastChangedRevision: 1255 $)[1];
+
+
+=head1 NAME
+
+Net::DNS::Resolver::android - Android Resolver Class
+
+=cut
+
+
+use strict;
+use base qw(Net::DNS::Resolver::Base);
+
+
+my $config_dir = $ENV{ANDROID_ROOT} || '/system';
+my $resolv_conf = "$config_dir/etc/resolv.conf";
+my $dotfile = '.resolv.conf';
+
+my @config_path;
+push( @config_path, $ENV{HOME} ) if exists $ENV{HOME};
+push( @config_path, '.' );
+
+
+sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
+
+
+sub init {
+ my @nameservers;
+ for ( 1 .. 4 ) {
+ my $ret = `getprop net.dns$_` || next;
+ chomp $ret;
+ push @nameservers, $ret || next;
+ }
+
+ my $defaults = shift->defaults;
+ $defaults->read_config_file($resolv_conf) if -f $resolv_conf && -r _;
+
+ $defaults->domain( _untaint $defaults->domain ); # untaint config values
+ $defaults->searchlist( _untaint $defaults->searchlist );
+ $defaults->nameservers( _untaint $defaults->nameservers(@nameservers) );
+
+ foreach my $dir (@config_path) {
+ my $file = "$dir/$dotfile";
+ $defaults->read_config_file($file) if -f $file && -r _ && -o _;
+ }
+
+ $defaults->read_env;
+}
+
+
+1;
+__END__
+
+
+=head1 SYNOPSIS
+
+ use Net::DNS::Resolver;
+
+=head1 DESCRIPTION
+
+This class implements the OS specific portions of C<Net::DNS::Resolver>.
+
+No user serviceable parts inside, see L<Net::DNS::Resolver|Net::DNS::Resolver>
+for all your resolving needs.
+
+=head1 COPYRIGHT
+
+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.
+
+=head1 SEE ALSO
+
+L<perl>, L<Net::DNS>, L<Net::DNS::Resolver>
+
+=cut
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::cygwin;
#
-# $Id: cygwin.pm 1233 2014-07-10 13:58:03Z willem $
+# $Id: cygwin.pm 1244 2014-08-12 22:10:45Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1233 $)[1];
+$VERSION = (qw$LastChangedRevision: 1244 $)[1];
=head1 NAME
@@ -33,9 +33,11 @@ sub getregkey {
}
+sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
+
+
sub init {
- my ($class) = @_;
- my $defaults = $class->defaults;
+ my $defaults = shift->defaults;
local *LM;
@@ -144,9 +146,14 @@ sub init {
$defaults->searchlist(@a);
}
- $class->read_env;
+ $defaults->domain( _untaint $defaults->domain ); # untaint config values
+ $defaults->searchlist( _untaint $defaults->searchlist );
+ $defaults->nameservers( _untaint $defaults->nameservers );
+
+ $defaults->read_env;
}
+
1;
__END__
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::os2;
#
-# $Id: os2.pm 1225 2014-07-01 19:38:51Z willem $
+# $Id: os2.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1225 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
=head1 NAME
@@ -26,17 +26,24 @@ push( @config_path, $ENV{HOME} ) if exists $ENV{HOME};
push( @config_path, '.' );
+sub _untaint { map defined && /^(.+)$/ ? $1 : (), @_; }
+
+
sub init {
- my ($class) = @_;
+ my $defaults = shift->defaults;
+
+ $defaults->read_config_file($resolv_conf) if -f $resolv_conf && -r _;
- $class->read_config_file($resolv_conf) if -f $resolv_conf && -r _;
+ $defaults->domain( _untaint $defaults->domain ); # untaint config values
+ $defaults->searchlist( _untaint $defaults->searchlist );
+ $defaults->nameservers( _untaint $defaults->nameservers );
foreach my $dir (@config_path) {
my $file = "$dir/$dotfile";
- $class->read_config_file($file) if -f $file && -r _ && -o _;
+ $defaults->read_config_file($file) if -f $file && -r _ && -o _;
}
- $class->read_env;
+ $defaults->read_env;
}
@@ -1,10 +1,10 @@
package Net::DNS::Text;
#
-# $Id: Text.pm 1229 2014-07-09 07:07:42Z willem $
+# $Id: Text.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1229 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
=head1 NAME
@@ -84,8 +84,7 @@ sub new {
local $_ = &_encode_utf8;
- s/^\042(.*)\042$/$1/; # strip paired quotes
- s/^\047(.*)\047$/$1/; # strip paired quotes
+ s/^\042(.*)\042$/$1/s; # strip paired quotes
s/\134\134/\134\060\071\062/g; # disguise escaped escape
s/\134([\060-\071]{3})/$unescape{$1}/eg; # numeric escape
@@ -1,10 +1,10 @@
package Net::DNS::ZoneFile;
#
-# $Id: ZoneFile.pm 1224 2014-07-01 07:57:42Z willem $
+# $Id: ZoneFile.pm 1235 2014-07-29 07:58:19Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1224 $)[1];
+$VERSION = (qw$LastChangedRevision: 1235 $)[1];
=head1 NAME
@@ -447,7 +447,7 @@ sub _getline { ## get line from current source
next unless /\S/; # discard blank line
next if /^\s*;/; # discard comment line
- if (/\(/) { # concatenate multi-line RR
+ if (/["(]/) { # concatenate multi-line RR
s/\\\\/\\092/g; # disguise escaped escape
s/\\"/\\034/g; # disguise escaped quote
s/\\\(/\\040/g; # disguise escaped bracket
@@ -466,6 +466,19 @@ sub _getline { ## get line from current source
last if $token[$#token] eq ')';
}
$_ = join ' ', @token; # reconstitute RR string
+
+ } elsif ( $token[$#token] =~ /^"[^"]+$/ ) {
+ while (<$fh>) {
+ s/\\\\/\\092/g; # disguise escaped escape
+ s/\\"/\\034/g; # disguise escaped quote
+ s/\\\(/\\040/g; # disguise escaped bracket
+ s/\\\)/\\041/g; # disguise escaped bracket
+ s/\\;/\\059/g; # disguise escaped semicolon
+ substr( $_, 0, 0 ) = pop @token || ''; # splice multi-line string
+ push @token, grep defined && length, split /$LEX_REGEX/o;
+ last unless $token[$#token] =~ /^"[^"]+$/;
+ }
+ $_ = join ' ', @token; # reconstitute RR string
}
}
@@ -1,11 +1,11 @@
package Net::DNS;
#
-# $Id: DNS.pm 1231 2014-07-10 09:12:57Z willem $
+# $Id: DNS.pm 1256 2014-08-22 22:02:17Z willem $
#
use vars qw($VERSION $SVNVERSION);
-$VERSION = '0.78';
-$SVNVERSION = (qw$LastChangedRevision: 1231 $)[1];
+$VERSION = '0.79';
+$SVNVERSION = (qw$LastChangedRevision: 1256 $)[1];
=head1 NAME
@@ -197,7 +197,7 @@ if (OLDDNSSEC) {
}
eval {
- no warnings 'void'; ## suppress "Too late to run INIT block ..."
+ #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;
@@ -1,7 +1,7 @@
-# $Id: 01-resolver-opt.t 1203 2014-05-20 12:25:01Z willem $ -*-perl-*-
+# $Id: 01-resolver-opt.t 1252 2014-08-19 13:14:41Z willem $ -*-perl-*-
-use Test::More tests => 59;
+use Test::More tests => 52;
use strict;
use File::Spec;
@@ -42,7 +42,7 @@ undef $res;
my %test_config = (
# NOTE: test breaks encapsulation, which limits what you can test
#
- #nameservers => ['10.0.0.1', '10.0.0.2'],
+ #nameservers => ['10.0.0.1', '10.0.0.2'],
port => 54,
srcaddr => '10.1.0.1',
srcport => 53,
@@ -92,16 +92,9 @@ foreach my $test (qw(nameservers searchlist)) {
undef $res;
my %bad_input = (
- tsig_rr => 'set',
errorstring => 'set',
answerfrom => 'set',
answersize => 'set',
- querytime => 'set',
- axfr_sel => 'set',
- axfr_rr => 'set',
- axfr_soa_count => 'set',
- udppacketsize => 'set',
- cdflag => 'set',
);
$res = Net::DNS::Resolver->new(%bad_input);
@@ -1,7 +1,7 @@
-# $Id: 03-rr.t 1229 2014-07-09 07:07:42Z willem $ -*-perl-*-
+# $Id: 03-rr.t 1235 2014-07-29 07:58:19Z willem $ -*-perl-*-
use strict;
-use Test::More tests => 52;
+use Test::More tests => 47;
BEGIN {
@@ -63,11 +63,6 @@ BEGIN {
q(example.com IN TXT txt-data),
q(example.com TXT txt-data),
q(example.com IN 0 TXT txt-data),
- q(example.com 0 IN TXT 'txt-data' ; 'quoted'),
- q(example.com 0 TXT 'txt-data'),
- q(example.com IN TXT 'txt-data'),
- q(example.com TXT 'txt-data'),
- q(example.com IN 0 TXT 'txt-data'),
q(example.com 0 IN TXT "txt-data" ; "quoted"),
q(example.com 0 TXT "txt-data"),
q(example.com IN TXT "txt-data"),
@@ -1,4 +1,4 @@
-# $Id: 10-recurse.t 1218 2014-06-11 08:26:33Z willem $ -*-perl-*-
+# $Id: 10-recurse.t 1240 2014-08-11 12:06:47Z willem $ -*-perl-*-
use strict;
use Test::More;
@@ -77,8 +77,6 @@ use_ok('Net::DNS::Resolver::Recurse');
ok( $res->hints(@HINTS), "hints() set" );
- ok( %{$res->{'hints'}}, 'sanity check worked' );
-
my $packet;
# Try a domain that is a CNAME
@@ -100,7 +98,7 @@ use_ok('Net::DNS::Resolver::Recurse');
$res->hints(@HINTS);
- my $count;
+ my $count = 0;
$res->recursion_callback(
sub {
@@ -115,3 +113,5 @@ use_ok('Net::DNS::Resolver::Recurse');
NonFatalEnd();
+
+exit;