[libnet-dns-perl] 01/06: New upstream version 0.80.2
Ondrej Sury
ondrej at moszumanska.debian.org
Sun Nov 2 12:27:24 UTC 2014
This is an automated email from the git hooks/post-receive script.
ondrej pushed a commit to branch master
in repository libnet-dns-perl.
commit 07ab8bbd19b75bc4629193ca99ac83b09e935125
Author: Ondřej Surý <ondrej at sury.org>
Date: Fri Oct 24 12:45:55 2014 +0200
New upstream version 0.80.2
---
Changes | 30 +++++++++++++++-
META.json | 4 +--
META.yml | 2 +-
lib/Net/DNS.pm | 77 +++++++++++++++++++----------------------
lib/Net/DNS/Domain.pm | 21 +++++------
lib/Net/DNS/DomainName.pm | 6 ++--
lib/Net/DNS/Nameserver.pm | 6 ++--
lib/Net/DNS/Packet.pm | 15 ++++----
lib/Net/DNS/RR.pm | 34 ++++++++----------
lib/Net/DNS/RR/A.pm | 9 +++--
lib/Net/DNS/RR/AAAA.pm | 11 +++---
lib/Net/DNS/RR/APL.pm | 14 ++++----
lib/Net/DNS/RR/LOC.pm | 9 +++--
lib/Net/DNS/RR/OPT.pm | 7 ++--
lib/Net/DNS/RR/TKEY.pm | 10 +++---
lib/Net/DNS/RR/TSIG.pm | 49 +++++++++++++++-----------
lib/Net/DNS/Resolver.pm | 7 ++--
lib/Net/DNS/Resolver/Base.pm | 36 ++++++++++---------
lib/Net/DNS/Resolver/Recurse.pm | 42 +++++++++++++---------
lib/Net/DNS/Text.pm | 12 +++----
lib/Net/DNS/Update.pm | 15 ++------
lib/Net/DNS/ZoneFile.pm | 6 ++--
t/05-TSIG.t | 9 ++---
23 files changed, 232 insertions(+), 199 deletions(-)
diff --git a/Changes b/Changes
index 8f2f2ba..fe0d58b 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,32 @@
-$Id: Changes 1267 2014-09-22 08:03:42Z willem $ -*-text-*-
+$Id: Changes 1277 2014-10-20 07:46:37Z willem $ -*-text-*-
+
+
+**** 0.81 [unreleased]
+
+Fix rt.cpan.org #99571
+
+ AXFR BADSIG failures
+
+Fix rt.cpan.org #99531
+
+ Resolver doc error - when is a 'bug' a 'bug'? [TSIG verification]
+
+Fix rt.cpan.org #99528
+
+ TSIG::create fails with some filenames
+
+Fix rt.cpan.org #99527
+
+ Random errors... [declaration with statement modifier]
+
+Fix rt.cpan.org #99429
+
+ Infinite recursion in Net::DNS::Resolver::Recurse::send when
+ following certain delegations with empty-non terminals.
+
+Fix rt.cpan.org #99320
+
+ Net::DNS::ZoneFile bug in "$ORIGIN ."
**** 0.80 Sep 22, 2014
diff --git a/META.json b/META.json
index b53b3fd..af7288f 100644
--- a/META.json
+++ b/META.json
@@ -42,6 +42,6 @@
}
}
},
- "release_status" : "stable",
- "version" : "0.80"
+ "release_status" : "testing",
+ "version" : "0.80_2"
}
diff --git a/META.yml b/META.yml
index e8115cf..cbeffb0 100644
--- a/META.yml
+++ b/META.yml
@@ -25,4 +25,4 @@ requires:
MIME::Base64: 2.11
Test::More: 0.52
perl: 5.00404
-version: 0.80
+version: 0.80_2
diff --git a/lib/Net/DNS.pm b/lib/Net/DNS.pm
index 93b9e28..f88fc46 100644
--- a/lib/Net/DNS.pm
+++ b/lib/Net/DNS.pm
@@ -1,11 +1,11 @@
package Net::DNS;
#
-# $Id: DNS.pm 1267 2014-09-22 08:03:42Z willem $
+# $Id: DNS.pm 1280 2014-10-24 08:15:06Z willem $
#
use vars qw($VERSION $SVNVERSION);
-$VERSION = '0.80';
-$SVNVERSION = (qw$LastChangedRevision: 1267 $)[1];
+$VERSION = '0.80_2';
+$SVNVERSION = (qw$LastChangedRevision: 1280 $)[1];
=head1 NAME
@@ -336,68 +336,63 @@ __END__
=head2 Resolver Objects
-A resolver object is an instance of the
-L<Net::DNS::Resolver|Net::DNS::Resolver> class. A program can have
-multiple resolver objects, each maintaining its own state information
-such as the nameservers to be queried, whether recursion is desired,
-etc.
+A resolver object is an instance of the L<Net::DNS::Resolver> class.
+A program can have multiple resolver objects, each maintaining its
+own state information such as the nameservers to be queried, whether
+recursion is desired, etc.
=head2 Packet Objects
-L<Net::DNS::Resolver|Net::DNS::Resolver> queries return
-L<Net::DNS::Packet|Net::DNS::Packet> objects. Packet objects have five
-sections:
+L<Net::DNS::Resolver> queries return L<Net::DNS::Packet> objects.
+Packet objects have five sections:
=over 3
=item *
-The header section, a L<Net::DNS::Header|Net::DNS::Header> object.
+The header section, a L<Net::DNS::Header> object.
=item *
-The question section, a list of L<Net::DNS::Question|Net::DNS::Question>
-objects.
+The question section, a list of L<Net::DNS::Question> objects.
=item *
-The answer section, a list of L<Net::DNS::RR|Net::DNS::RR> objects.
+The answer section, a list of L<Net::DNS::RR> objects.
=item *
-The authority section, a list of L<Net::DNS::RR|Net::DNS::RR> objects.
+The authority section, a list of L<Net::DNS::RR> objects.
=item *
-The additional section, a list of L<Net::DNS::RR|Net::DNS::RR> objects.
+The additional section, a list of L<Net::DNS::RR> objects.
=back
=head2 Update Objects
-The L<Net::DNS::Update|Net::DNS::Update> package is a subclass of
-L<Net::DNS::Packet|Net::DNS::Packet> for creating packet objects to be
-used in dynamic updates.
+L<Net::DNS::Update> is a subclass of L<Net::DNS::Packet>
+used to create dynamic update requests.
=head2 Header Objects
-L<Net::DNS::Header|Net::DNS::Header> objects represent the header
+L<Net::DNS::Header> objects represent the header
section of a DNS packet.
=head2 Question Objects
-L<Net::DNS::Question|Net::DNS::Question> objects represent the content
-of the question section of a DNS packet.
+L<Net::DNS::Question> objects represent the content of the question
+section of a DNS packet.
=head2 RR Objects
-L<Net::DNS::RR|Net::DNS::RR> is the base class for DNS resource record
-(RR) objects in the answer, authority, and additional sections of a DNS
-packet.
+L<Net::DNS::RR> is the base class for DNS resource record (RR) objects
+in the answer, authority, and additional sections of a DNS packet.
-Do not assume that RR objects will be of the type you requested -- always
-check the type of an RR object before calling any of its methods.
+Do not assume that RR objects will be of the type requested.
+The type of an RR object must be checked before calling any methods.
=head1 METHODS
@@ -412,7 +407,7 @@ Returns the version of Net::DNS.
=head2 mx
- # Use a default resolver -- can't get an error string this way.
+ # Use a default resolver -- can not get an error string this way.
use Net::DNS;
my @mx = mx("example.com");
@@ -421,12 +416,12 @@ Returns the version of Net::DNS.
my $res = Net::DNS::Resolver->new;
my @mx = mx($res, "example.com");
-Returns a list of L<Net::DNS::RR::MX|Net::DNS::RR::MX> objects
-representing the MX records for the specified name; the list will be
-sorted by preference. Returns an empty list if the query failed or no MX
-records were found.
+Returns a list of L<Net::DNS::RR::MX> objects representing the MX
+records for the specified name.
+The list will be sorted by preference.
+Returns an empty list if the query failed or no MX record was found.
-This method does not look up A records -- it only performs MX queries.
+This method does not look up A records; it only performs MX queries.
See L</EXAMPLES> for a more complete example.
@@ -455,7 +450,7 @@ exist.
Meaning: At least one RR with the specified name and type must
exist and must have matching data.
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
+Returns a C<Net::DNS::RR> object or C<undef> if the object could not
be created.
=head2 nxrrset
@@ -467,7 +462,7 @@ a dynamic update packet.
Meaning: No RRs with the specified name and type can exist.
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
+Returns a C<Net::DNS::RR> object or C<undef> if the object could not
be created.
=head2 yxdomain
@@ -479,7 +474,7 @@ update packet.
Meaning: At least one RR with the specified name must exist.
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
+Returns a C<Net::DNS::RR> object or C<undef> if the object could not
be created.
=head2 nxdomain
@@ -491,7 +486,7 @@ dynamic update packet.
Meaning: No RR with the specified name can exist.
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
+Returns a C<Net::DNS::RR> object or C<undef> if the object could not
be created.
=head2 rr_add
@@ -506,7 +501,7 @@ RR objects created by this method should be added to the "update"
section of a dynamic update packet. The TTL defaults to 86400
seconds (24 hours) if not specified.
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
+Returns a C<Net::DNS::RR> object or C<undef> if the object could not
be created.
=head2 rr_del
@@ -532,7 +527,7 @@ Meaning: Delete all RRs having the specified name, type, and data.
RR objects created by this method should be added to the "update"
section of a dynamic update packet.
-Returns a C<Net::DNS::RR> object or C<undef> if the object couldn't
+Returns a C<Net::DNS::RR> object or C<undef> if the object could not
be created.
@@ -663,7 +658,7 @@ dynamic updates.
print $rr->preference, " ", $rr->exchange, "\n";
}
} else {
- warn "Can't find MX records for $name: ", $res->errorstring, "\n";
+ warn "Can not find MX records for $name: ", $res->errorstring, "\n";
}
diff --git a/lib/Net/DNS/Domain.pm b/lib/Net/DNS/Domain.pm
index 2d6805b..d8d88b4 100644
--- a/lib/Net/DNS/Domain.pm
+++ b/lib/Net/DNS/Domain.pm
@@ -1,15 +1,15 @@
package Net::DNS::Domain;
#
-# $Id: Domain.pm 1222 2014-06-24 12:30:08Z willem $
+# $Id: Domain.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1222 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
=head1 NAME
-Net::DNS::Domain - Domain Name System domains
+Net::DNS::Domain - DNS domains
=head1 SYNOPSIS
@@ -59,9 +59,9 @@ use constant LIBIDN => eval {
} || 0;
-# perlcc: eddress of encoding objects must be determined at runtime
-my $ascii = Encode::find_encoding('ascii') if ASCII; # Osborn's Law:
-my $utf8 = Encode::find_encoding('utf8') if UTF8; # Variables won't; constants aren't.
+# perlcc: address of encoding objects must be determined at runtime
+my $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law:
+my $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't.
=head1 METHODS
@@ -151,7 +151,8 @@ sub name {
my $head = _decode_ascii( join chr(46), map _escape($_), @$lref );
my $tail = $self->{origin} || return $self->{name} = $head || $dot;
return $self->{name} = $tail->name unless length $head;
- return $self->{name} = join $dot, $head, $tail->name;
+ my $suffix = $tail->name;
+ return $self->{name} = $suffix eq $dot ? $head : join $dot, $head, $suffix;
}
@@ -243,10 +244,10 @@ where relative names become descendents of the specified $ORIGIN.
my $placebo = sub { my $constructor = shift; &$constructor; };
sub origin {
- my $class = shift;
- my $name = shift || return $placebo;
+ my ( $class, $name ) = @_;
- my $domain = new Net::DNS::Domain($name);
+ my $domain = defined $name ? new Net::DNS::Domain($name) : return $placebo;
+ $domain = undef unless scalar @{$domain->{label}};
return sub { # closure w.r.t. $domain
my $constructor = shift;
local $ORIGIN = $domain; # dynamically scoped $ORIGIN
diff --git a/lib/Net/DNS/DomainName.pm b/lib/Net/DNS/DomainName.pm
index 13c71cf..8dc8f72 100644
--- a/lib/Net/DNS/DomainName.pm
+++ b/lib/Net/DNS/DomainName.pm
@@ -1,15 +1,15 @@
package Net::DNS::DomainName;
#
-# $Id: DomainName.pm 1222 2014-06-24 12:30:08Z willem $
+# $Id: DomainName.pm 1272 2014-10-10 22:21:43Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1222 $)[1];
+$VERSION = (qw$LastChangedRevision: 1272 $)[1];
=head1 NAME
-Net::DNS::DomainName - DNS domain name wire representation
+Net::DNS::DomainName - DNS name representation
=head1 SYNOPSIS
diff --git a/lib/Net/DNS/Nameserver.pm b/lib/Net/DNS/Nameserver.pm
index 1984318..58aafee 100644
--- a/lib/Net/DNS/Nameserver.pm
+++ b/lib/Net/DNS/Nameserver.pm
@@ -1,10 +1,10 @@
package Net::DNS::Nameserver;
#
-# $Id: Nameserver.pm 1222 2014-06-24 12:30:08Z willem $
+# $Id: Nameserver.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1222 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
=head1 NAME
@@ -412,7 +412,7 @@ sub udp_connection {
};
my $reply = $self->make_reply( $query, $peerhost, $conn ) || return;
- my $max_len = $query->edns->size if $query && $self->{Truncate};
+ my $max_len = ( $query && $self->{Truncate} ) ? $query->edns->size : undef;
if ( $self->{Verbose} ) {
local $| = 1;
print "Maximum UDP size advertised by $peerhost:$peerport: $max_len\n" if $max_len;
diff --git a/lib/Net/DNS/Packet.pm b/lib/Net/DNS/Packet.pm
index fcdb09a..f79d26c 100644
--- a/lib/Net/DNS/Packet.pm
+++ b/lib/Net/DNS/Packet.pm
@@ -1,10 +1,10 @@
package Net::DNS::Packet;
#
-# $Id: Packet.pm 1246 2014-08-14 19:39:22Z willem $
+# $Id: Packet.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1246 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
=head1 NAME
@@ -39,7 +39,8 @@ BEGIN {
require Net::DNS::RR;
}
-my @dummy_header = ( header => {} ) if Net::DNS::RR->COMPATIBLE;
+use constant OLDDNSSEC => Net::DNS::RR->COMPATIBLE;
+my @dummy_header = OLDDNSSEC ? ( header => {} ) : ();
=head1 METHODS
@@ -227,7 +228,7 @@ represents the header section of the packet.
sub header {
my $self = shift;
- return bless \$self, q(Net::DNS::Header);
+ bless \$self, q(Net::DNS::Header);
}
@@ -237,7 +238,7 @@ sub header {
$version = $edns->version;
$size = $edns->size;
-Auxilliary function edns() provides access to EDNS extensions.
+Auxiliary function edns() provides access to EDNS extensions.
=cut
@@ -245,7 +246,7 @@ sub edns {
my $self = shift;
my $link = \$self->{xedns};
($$link) = grep $_->isa(qw(Net::DNS::RR::OPT)), @{$self->{additional}} unless $$link;
- return $$link ||= new Net::DNS::RR( type => 'OPT' );
+ $$link ||= new Net::DNS::RR( type => 'OPT' );
}
@@ -828,7 +829,7 @@ The minimum maximum length that is honoured is 512 octets.
# The TC bit should be set in responses only when an RRSet is required
# as a part of the response, but could not be included in its entirety.
# The TC bit should not be set merely because some extra information
-# could have been included, but there was insufficient room. This
+# could have been included, for which there was insufficient room. This
# includes the results of additional section processing. In such cases
# the entire RRSet that will not fit in the response should be omitted,
# and the reply sent as is, with the TC bit clear. If the recipient of
diff --git a/lib/Net/DNS/RR.pm b/lib/Net/DNS/RR.pm
index 7db1029..e8ed368 100644
--- a/lib/Net/DNS/RR.pm
+++ b/lib/Net/DNS/RR.pm
@@ -1,15 +1,15 @@
package Net::DNS::RR;
#
-# $Id: RR.pm 1260 2014-09-09 09:12:28Z willem $
+# $Id: RR.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1260 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
=head1 NAME
-Net::DNS::RR - DNS Resource Record base class
+Net::DNS::RR - DNS resource record base class
=head1 SYNOPSIS
@@ -203,11 +203,7 @@ sub _new_hash {
$self->ttl($ttl) if defined $ttl; # specify TTL
while ( my ( $attribute, $value ) = each %attribute ) {
- if ( UNIVERSAL::isa( $value, 'ARRAY' ) ) {
- $self->$attribute(@$value); # attribute => [ ... ]
- } else {
- $self->$attribute($value); # attribute => value
- }
+ $self->$attribute( ref($value) eq 'ARRAY' ? @$value : $value );
}
if ( COMPATIBLE && $self->{OLD} ) {
@@ -378,11 +374,10 @@ the trailing dot.
sub string {
my $self = shift;
- my $name = $self->name if COMPATIBLE;
+ my $name = COMPATIBLE ? $self->name : '';
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;
@@ -425,7 +420,6 @@ Returns the record type.
sub type {
my $self = shift;
-
croak 'not possible to change RR->type' if scalar @_;
return $self->{type} || 'A' if COMPATIBLE;
@@ -631,11 +625,11 @@ sub get_rrsort_func {
}
-###################################################################################
+################################################################################
##
## Default implementation for unknown RR type
##
-###################################################################################
+################################################################################
sub decode_rdata { ## decode rdata from wire-format octet string
my ( $self, $data, $offset ) = @_;
@@ -676,6 +670,8 @@ sub dump { ## print internal data structure
}
+################################################################################
+
#
# Net::DNS::RR->_subclass($rrtype)
# Net::DNS::RR->_subclass($rrtype, $default)
@@ -725,11 +721,11 @@ sub _subclass {
}
-###################################################################################
+################################################################################
## Compatibility interface to allow old and new RR architectures to coexist
##
## "new" modules inherit these methods to wrap themselves in "old" clothing.
-###################################################################################
+################################################################################
sub _new_from_rdata { ## decode rdata from wire-format byte string
my $class = shift;
@@ -779,7 +775,7 @@ sub _normalize_ownername { }
sub _normalize_dnames { }
-###################################################################################
+################################################################################
use vars qw($AUTOLOAD);
@@ -791,7 +787,7 @@ sub AUTOLOAD { ## Default method
confess 'undefined method ', $AUTOLOAD unless $oref;
confess 'unimplemented type ', $self->type if $oref eq __PACKAGE__;
- my $method = $1 if $AUTOLOAD =~ m/^.*::(.*)$/;
+ my $method = $AUTOLOAD =~ m/^.*::(.*)$/ ? $1 : '<undef>';
if (COMPATIBLE) {
return $self->{$method} = shift if @_;
@@ -804,7 +800,7 @@ sub AUTOLOAD { ## Default method
*** FATAL PROGRAM ERROR!! Unknown method '$method'
*** which the program has attempted to call for the object:
***
-*** $object
+ $object
***
*** This object does not have a method '$method'. THIS IS A BUG
*** IN THE CALLING SOFTWARE, which incorrectly assumes that the
@@ -816,7 +812,7 @@ END
}
-###################################################################################
+################################################################################
## Stub implementation of Net::DNS::RR::OPT to avoid a barrage of confusing failure
## reports if the subtype implementation module is absent or fails to load.
diff --git a/lib/Net/DNS/RR/A.pm b/lib/Net/DNS/RR/A.pm
index 9a77bf3..f092fbc 100644
--- a/lib/Net/DNS/RR/A.pm
+++ b/lib/Net/DNS/RR/A.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::A;
#
-# $Id: A.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: A.pm 1272 2014-10-10 22:21:43Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1272 $)[1];
use strict;
@@ -51,14 +51,17 @@ sub parse_rdata { ## populate RR from rdata in argument list
}
+my $pad = pack 'x4';
+
sub address {
my $self = shift;
- return join '.', unpack( 'C4', $self->{address} ) unless scalar @_;
+ return join '.', unpack 'C4', $self->{address} . $pad unless scalar @_;
# Note: pack masks overlarge values, mostly without warning
my @part = split /\./, shift || '';
my $last = pop(@part) || 0;
+ $self = {} unless ref($self);
$self->{address} = pack 'C4', @part, (0) x ( 3 - @part ), $last;
}
diff --git a/lib/Net/DNS/RR/AAAA.pm b/lib/Net/DNS/RR/AAAA.pm
index 7513a97..9f5fefb 100644
--- a/lib/Net/DNS/RR/AAAA.pm
+++ b/lib/Net/DNS/RR/AAAA.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::AAAA;
#
-# $Id: AAAA.pm 1235 2014-07-29 07:58:19Z willem $
+# $Id: AAAA.pm 1272 2014-10-10 22:21:43Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1235 $)[1];
+$VERSION = (qw$LastChangedRevision: 1272 $)[1];
use strict;
@@ -51,13 +51,15 @@ sub parse_rdata { ## populate RR from rdata in argument list
}
+my $pad = pack 'x16';
+
sub address_long {
- return sprintf '%x:%x:%x:%x:%x:%x:%x:%x', unpack 'n8', shift->{address};
+ sprintf '%x:%x:%x:%x:%x:%x:%x:%x', unpack 'n8', shift->{address} . $pad;
}
sub address_short {
- for ( sprintf ':%x:%x:%x:%x:%x:%x:%x:%x:', unpack 'n8', shift->{address} ) {
+ for ( sprintf ':%x:%x:%x:%x:%x:%x:%x:%x:', unpack 'n8', shift->{address} . $pad ) {
s/(:0[:0]+:)(?!.+:0\1)/::/; # squash longest zero sequence
s/^:// unless /^::/; # prune LH :
s/:$// unless /::$/; # prune RH :
@@ -73,6 +75,7 @@ sub address {
my $argument = shift || '';
my @parse = split /:/, "0$argument";
+ $self = {} unless ref($self);
if ( (@parse)[$#parse] =~ /\./ ) { # embedded IPv4
my @ip4 = split /\./, pop(@parse);
diff --git a/lib/Net/DNS/RR/APL.pm b/lib/Net/DNS/RR/APL.pm
index b7598ea..cdf783e 100644
--- a/lib/Net/DNS/RR/APL.pm
+++ b/lib/Net/DNS/RR/APL.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::APL;
#
-# $Id: APL.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: APL.pm 1272 2014-10-10 22:21:43Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1272 $)[1];
use strict;
@@ -137,11 +137,10 @@ sub prefix {
sub _address_1 {
my $self = shift;
- my $dummy = {address => pack( 'a* @4', $self->{address} || '' )};
- return Net::DNS::RR::A::address($dummy) unless scalar @_;
+ return bless( {%$self}, 'Net::DNS::RR::A' )->address unless scalar @_;
my $alength = ( $self->prefix + 7 ) >> 3; # mask non-prefix bits, suppress nulls
- my @address = unpack "C$alength", Net::DNS::RR::A::address( $dummy, shift );
+ my @address = unpack "C$alength", Net::DNS::RR::A->address(shift);
my $bitmask = 0xFF << ( 8 - $self->prefix & 7 );
push @address, ( $bitmask & pop(@address) ) if $alength;
for ( reverse @address ) { last if $_; pop @address }
@@ -152,11 +151,10 @@ sub prefix {
sub _address_2 {
my $self = shift;
- my $dummy = {address => pack( 'a* @16', $self->{address} || '' )};
- return Net::DNS::RR::AAAA::address_long($dummy) unless scalar @_;
+ return bless( {%$self}, 'Net::DNS::RR::AAAA' )->address_long unless scalar @_;
my $alength = ( $self->prefix + 7 ) >> 3; # mask non-prefix bits, suppress nulls
- my @address = unpack "C$alength", Net::DNS::RR::AAAA::address( $dummy, shift );
+ my @address = unpack "C$alength", Net::DNS::RR::AAAA->address(shift);
my $bitmask = 0xFF << ( 8 - $self->prefix & 7 );
push @address, ( $bitmask & pop(@address) ) if $alength;
for ( reverse @address ) { last if $_; pop @address }
diff --git a/lib/Net/DNS/RR/LOC.pm b/lib/Net/DNS/RR/LOC.pm
index 251d727..d4e1819 100644
--- a/lib/Net/DNS/RR/LOC.pm
+++ b/lib/Net/DNS/RR/LOC.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::LOC;
#
-# $Id: LOC.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: LOC.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
use strict;
@@ -44,7 +44,7 @@ sub format_rdata { ## format rdata portion of RR string.
my $self = shift;
return '' unless defined $self->{longitude};
- my @angular = ( $self->latitude, $self->longitude );
+ my @angular = ( $self->latitude, ' ', $self->longitude, ' ' );
my @linear = ( $self->altitude, $self->size, $self->hp, $self->vp );
join ' ', @angular, join 'm ', @linear, '';
}
@@ -172,8 +172,7 @@ sub _decode_lat {
sub _encode_lat {
my @ang = scalar @_ > 1 ? (@_) : ( split /[\s\260'"]+/, shift || '0' );
my $ang = ( 0 + shift @ang ) * 3600000;
- my $neg = pop(@ang) =~ /[SWsw]/ if scalar @ang;
- undef $neg if $ang < 0;
+ my $neg = ( @ang ? pop @ang : '' ) =~ /[SWsw]/ && $ang > 0;
$ang += ( @ang ? shift @ang : 0 ) * 60000;
$ang += ( @ang ? shift @ang : 0 ) * 1000;
return int( 0.5 + ( $neg ? $datum_loc - $ang : $datum_loc + $ang ) );
diff --git a/lib/Net/DNS/RR/OPT.pm b/lib/Net/DNS/RR/OPT.pm
index 6683d63..33cf44f 100644
--- a/lib/Net/DNS/RR/OPT.pm
+++ b/lib/Net/DNS/RR/OPT.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::OPT;
#
-# $Id: OPT.pm 1229 2014-07-09 07:07:42Z willem $
+# $Id: OPT.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1229 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
use strict;
@@ -121,9 +121,8 @@ sub class { ## overide RR method
sub ttl { ## overide RR method
my $self = shift;
- my $mods = shift || return if scalar @_;
carp qq[Usage: OPT has no "ttl" attribute, please use "flags()" and "rcode()"] unless $warned++;
- @{$self}{qw(rcode version flags)} = unpack 'C2 n', pack 'N', $mods if $mods;
+ @{$self}{qw(rcode version flags)} = unpack 'C2 n', pack 'N', shift || 0 if scalar @_;
return pack 'C2 n', @{$self}{qw(rcode version flags)} if defined wantarray;
}
diff --git a/lib/Net/DNS/RR/TKEY.pm b/lib/Net/DNS/RR/TKEY.pm
index e6ec52b..ded775a 100644
--- a/lib/Net/DNS/RR/TKEY.pm
+++ b/lib/Net/DNS/RR/TKEY.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::TKEY;
#
-# $Id: TKEY.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: TKEY.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
use strict;
@@ -156,7 +156,7 @@ __END__
=head1 DESCRIPTION
-Class for DNS Transaction Signature (TKEY) resource records.
+Class for DNS TSIG Key (TKEY) resource records.
=head1 METHODS
@@ -222,8 +222,8 @@ The meaning of this data depends on the mode.
$other = $rr->other;
$rr->other( $other );
-Not defined in [RFC2930] specification but may be used in future
-extensions.
+Content not defined in the [RFC2930] specification but may be used
+in future extensions.
=head1 COPYRIGHT
diff --git a/lib/Net/DNS/RR/TSIG.pm b/lib/Net/DNS/RR/TSIG.pm
index 331be04..7b6342a 100644
--- a/lib/Net/DNS/RR/TSIG.pm
+++ b/lib/Net/DNS/RR/TSIG.pm
@@ -1,10 +1,10 @@
package Net::DNS::RR::TSIG;
#
-# $Id: TSIG.pm 1188 2014-04-03 18:54:34Z willem $
+# $Id: TSIG.pm 1279 2014-10-24 08:12:21Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1188 $)[1];
+$VERSION = (qw$LastChangedRevision: 1279 $)[1];
use strict;
@@ -75,6 +75,7 @@ sub decode_rdata { ## decode rdata from wire-format octet string
my $self = shift;
my ( $data, $offset ) = @_;
+ my $eom = $offset - Net::DNS::RR->RRFIXEDSZ - length $self->{owner}->encode();
( $self->{algorithm}, $offset ) = decode Net::DNS::DomainName(@_);
# Design decision: Use 32 bits, which will work until the end of time()!
@@ -90,6 +91,11 @@ sub decode_rdata { ## decode rdata from wire-format octet string
my $other_size = unpack "\@$offset n", $$data;
$self->{other} = unpack "\@$offset xx a$other_size", $$data;
+ $offset += $other_size + 2;
+
+ croak('misplaced or corrupt TSIG') unless $offset == length $$data;
+ substr( $$data, $eom ) = '';
+ $self->{rawref} = $data;
}
@@ -267,18 +273,19 @@ sub sign_func { &sig_function; } ## historical
sub sig_data {
- my $self = shift;
- my $data = shift || '';
-
- if ( ref($data) ) {
- my $packet = $data if $data->isa('Net::DNS::Packet');
- die 'missing packet reference' unless $packet;
-
- my $original = $packet->{additional};
- my @unsigned = grep ref($_) ne ref($self), @$original;
- $packet->{additional} = \@unsigned; # strip TSIG RR
- $data = $packet->data;
- $packet->{additional} = $original; # reinstate TSIG RR
+ my ( $self, $message ) = @_;
+
+ if ( ref($message) ) {
+ die 'missing packet reference' unless $message->isa('Net::DNS::Packet');
+ my @unsigned = grep ref($_) ne ref($self), @{$message->{additional}};
+ local $message->{additional} = \@unsigned; # remake header image
+ my @part = qw(question answer authority additional);
+ my @size = map scalar( @{$message->{$_}} ), @part;
+ my $data = $self->{rawref};
+ delete $self->{rawref};
+ my $orig = $data ? $self->original_id : $message->{id};
+ my $hbin = pack 'n6', $orig, $message->{status}, @size;
+ $message = $hbin . substr $data ? $$data : $message->data, length $hbin;
}
# Design decision: Use 32 bits, which will work until the end of time()!
@@ -287,15 +294,14 @@ sub sig_data {
# Insert the prior MAC if present (multi-packet message).
$self->prior_macbin( $self->{link}->macbin ) if $self->{link};
if ( my $prior_mac = $self->prior_macbin ) {
- return pack 'na* a* a*', length($prior_mac), $prior_mac, $data, $time;
+ return pack 'na* a* a*', length($prior_mac), $prior_mac, $message, $time;
}
# Insert the request MAC if present (used to validate responses).
- my $sigdata = '';
my $req_mac = $self->request_macbin;
- $sigdata = pack 'na*', length($req_mac), $req_mac if $req_mac;
+ my $sigdata = $req_mac ? pack( 'na*', length($req_mac), $req_mac ) : '';
- $sigdata .= $data;
+ $sigdata .= $message || '';
my $kname = $self->{owner}->canonical; # canonical key name
$sigdata .= pack 'a* n N', $kname, ANY, 0;
@@ -339,8 +345,8 @@ sub create {
key => $key
);
- } elsif ( $karg =~ /K([^+]+)[+0-9]+\.private$/ ) { # ( keyfile, options )
- my $kname = $1;
+ } elsif ( $karg =~ /[+.0-9]+private$/ ) { # ( keyfile, options )
+ require File::Spec;
require Net::DNS::ZoneFile;
my $keyfile = new Net::DNS::ZoneFile($karg);
my ( $alg, $key, $junk );
@@ -350,6 +356,9 @@ sub create {
( $junk, $key ) = split if /Key:/;
}
}
+
+ my ( $vol, $dir, $file ) = File::Spec->splitpath( $keyfile->name );
+ my $kname = $file =~ /^K([^+]+)+.+private$/ ? $1 : undef;
return new Net::DNS::RR(
name => $kname,
type => 'TSIG',
diff --git a/lib/Net/DNS/Resolver.pm b/lib/Net/DNS/Resolver.pm
index cc5b672..b3f4113 100644
--- a/lib/Net/DNS/Resolver.pm
+++ b/lib/Net/DNS/Resolver.pm
@@ -1,10 +1,10 @@
package Net::DNS::Resolver;
#
-# $Id: Resolver.pm 1266 2014-09-22 08:00:05Z willem $
+# $Id: Resolver.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1266 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
=head1 NAME
@@ -771,9 +771,6 @@ For example, if we wanted to cache lookups:
=head1 BUGS
-The current implementation supports TSIG only on outgoing packets.
-No validation of server replies is performed.
-
bgsend() does not honour the usevc flag and only uses UDP for transport.
=head1 COPYRIGHT
diff --git a/lib/Net/DNS/Resolver/Base.pm b/lib/Net/DNS/Resolver/Base.pm
index 4c963f8..17d3a52 100644
--- a/lib/Net/DNS/Resolver/Base.pm
+++ b/lib/Net/DNS/Resolver/Base.pm
@@ -1,10 +1,10 @@
package Net::DNS::Resolver::Base;
#
-# $Id: Base.pm 1260 2014-09-09 09:12:28Z willem $
+# $Id: Base.pm 1277 2014-10-20 07:46:37Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1260 $)[1];
+$VERSION = (qw$LastChangedRevision: 1277 $)[1];
use strict;
@@ -18,7 +18,7 @@ use IO::Select;
use Net::DNS::RR;
use Net::DNS::Packet;
-use constant DNSSEC => eval { require Net::DNS::RR::DS; } || 0;
+use constant DNSSEC => eval { require Net::DNS::RR::DNSKEY; } || 0;
use constant INT16SZ => 2;
use constant PACKETSZ => 512;
@@ -154,7 +154,7 @@ my $initial;
sub new {
my $class = shift;
- my %args = @_ unless scalar(@_) % 2;
+ my %args = ( scalar(@_) % 2 ) ? () : @_;
my $self;
my $base = $class->defaults;
@@ -351,7 +351,7 @@ sub nameservers {
my $packet = $defres->search( $ns, 'A' );
$self->errorstring( $defres->errorstring );
- my @address = cname_addr( [@names], $packet ) if defined $packet;
+ my @address = $packet ? cname_addr( [@names], $packet ) : ();
if ($has_inet6) {
$packet = $defres->search( $ns, 'AAAA' );
@@ -372,8 +372,8 @@ sub nameservers {
return unless defined wantarray;
}
- my @ns4 = @{$self->{nameserver4}} unless $self->force_v6;
- my @ns6 = @{$self->{nameserver6}} if $has_inet6 && !$self->force_v4;
+ my @ns4 = $self->force_v6 ? () : @{$self->{nameserver4}};
+ my @ns6 = $has_inet6 && !$self->force_v4 ? @{$self->{nameserver6}} : ();
my @returnval = $self->prefer_v6 ? ( @ns6, @ns4 ) : ( @ns4, @ns6 );
return @returnval if scalar @returnval;
@@ -446,8 +446,8 @@ sub search {
my $self = shift;
my $name = shift || '.';
- my $defdomain = $self->{domain} if $self->{defnames};
- my @searchlist = @{$self->{'searchlist'}} if $self->{dnsrch};
+ my $defdomain = $self->{defnames} ? $self->{domain} : undef;
+ my @searchlist = $self->{dnsrch} ? @{$self->{'searchlist'}} : ();
# resolve name by trying as absolute name, then applying searchlist
my @list = ( undef, @searchlist );
@@ -483,7 +483,7 @@ sub query {
my $name = shift || '.';
# resolve name containing no dots or colons by appending domain
- my @suffix = ( $self->{domain} || () ) if $name !~ m/[:.]/ and $self->{defnames};
+ my @suffix = ( $name !~ m/[:.]/ && $self->{defnames} ) ? ( $self->{domain} || () ) : ();
my $fqname = join '.', $name, @suffix;
@@ -655,7 +655,7 @@ sub send_udp {
my $lastanswer;
- my $stop_time = time + $self->{'udp_timeout'} if $self->{'udp_timeout'};
+ my $stop_time = $self->{'udp_timeout'} ? time + $self->{'udp_timeout'} : undef;
$self->_reset_errorstring;
@@ -1094,7 +1094,7 @@ sub make_query_packet {
$header->ad(0);
$header->do(0);
- } elsif ( $self->{adflag} ) {
+ } elsif ( $self->{adflag} ) { # RFC6840, 5.7
print ";; Set AD flag\n" if $self->{debug};
$header->ad(1);
$header->cd(0);
@@ -1124,9 +1124,11 @@ sub axfr { ## zone transfer
my @null;
my $query = $self->_axfr_start(@_) || return $whole ? @null : sub {undef};
my $reply = $self->_axfr_next() || return $whole ? @null : sub {undef};
- my $verfy = $reply->verify($query) || croak $reply->verifyerr if $query->sigrr;
my @rr = $reply->answer;
my $soa = $rr[0];
+ my $verfy = $query->sigrr();
+ $verfy = $reply->verify($query) || croak $reply->verifyerr if $verfy;
+ print ';; ', $verfy ? '' : 'not ', "verified\n" if $self->{debug};
if ($whole) {
my @zone = shift @rr;
@@ -1135,7 +1137,8 @@ sub axfr { ## zone transfer
push @zone, @rr; # unpack non-terminal packet
@rr = @null;
$reply = $self->_axfr_next() || last;
- $verfy = $reply->verify($verfy) || croak $reply->verifyerr if $query->sigrr;
+ $verfy = $reply->verify($verfy) || croak $reply->verifyerr if $verfy;
+ print ';; ', $verfy ? '' : 'not ', "verified\n" if $self->{debug};
@rr = $reply->answer;
}
@@ -1160,7 +1163,8 @@ sub axfr { ## zone transfer
}
$reply = $self->_axfr_next() || return undef; # end of packet
- $verfy = $reply->verify($verfy) || croak $reply->verifyerr if $query->sigrr;
+ $verfy = $reply->verify($verfy) || croak $reply->verifyerr if $verfy;
+ print ';; ', $verfy ? '' : 'not ', "verified\n" if $self->{debug};
@rr = $reply->answer;
return $rr;
};
@@ -1560,7 +1564,7 @@ __END__
=head1 NAME
-Net::DNS::Resolver::Base - Common Resolver Class
+Net::DNS::Resolver::Base - DNS resolver base class
=head1 SYNOPSIS
diff --git a/lib/Net/DNS/Resolver/Recurse.pm b/lib/Net/DNS/Resolver/Recurse.pm
index 845d608..c998719 100644
--- a/lib/Net/DNS/Resolver/Recurse.pm
+++ b/lib/Net/DNS/Resolver/Recurse.pm
@@ -1,15 +1,15 @@
package Net::DNS::Resolver::Recurse;
#
-# $Id: Recurse.pm 1259 2014-09-08 10:33:49Z willem $
+# $Id: Recurse.pm 1274 2014-10-14 20:35:58Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1259 $)[1];
+$VERSION = (qw$LastChangedRevision: 1274 $)[1];
=head1 NAME
-Net::DNS::Resolver::Recurse - Perform recursive DNS lookups
+Net::DNS::Resolver::Recurse - DNS recursive resolver
=head1 SYNOPSIS
@@ -125,11 +125,12 @@ sub send {
return $packet;
}
- my $domain = $question->qtype ne 'NULL' ? $original->qname : join '.', @tail;
+ my $domain = lc join( '.', @tail ) || '.';
my $nslist = $res->{cache}->{$domain} ||= [];
if ( scalar @$nslist ) {
- print ";; using cached nameservers for $domain.\n" if $res->{debug};
+ print ";; using cached nameservers for $domain\n" if $res->{debug};
} else {
+ $domain = lc $question->qname if $question->qtype ne 'NULL';
my $packet = $res->send( $domain, 'NULL', 'ANY', $original ) || return;
return $packet unless $packet->header->rcode eq 'NOERROR';
@@ -137,17 +138,20 @@ sub send {
return $packet if $packet->header->aa && grep $_->name eq $original->qname, @answer;
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 %auth = map { lc $_->nsdname => lc $_->name } @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 }
- @$nslist = values %glue;
- my @noglue = grep !$glue{$_}, keys %auth;
- push @$nslist, @noglue;
+ my %zone = reverse %auth;
+ foreach my $zone ( keys %zone ) {
+ print ";; cache nameservers for $zone\n" if $res->{debug};
+ my @nsname = grep $auth{$_} eq $zone, keys %auth;
+ $nslist = $res->{cache}->{$zone} ||= [];
+ @$nslist = map $glue{$_} || $_, @nsname;
+ last if $zone eq $domain;
+ }
}
my $query = new Net::DNS::Packet();
@@ -158,18 +162,21 @@ sub send {
splice @a, 0, 0, splice( @a, int( rand scalar @a ) ); # cut deck
foreach (@a) {
+ $res->empty_nameservers();
$res->nameservers( map @$_, @a );
my $reply = $res->send($query) || last;
$res->{callback}->($reply) if $res->{callback};
return $reply;
}
- foreach my $ns ( grep !ref($_), @$nslist ) {
- print ";; find missing glue for $domain. ($ns)\n" if $res->{debug};
+ foreach my $ns (@$nslist) {
+ next if ref($ns);
+ my $name = $ns;
+ print ";; find missing glue for $name\n" if $res->{debug};
+ $ns = []; # substitute IP list in situ
$res->empty_nameservers();
- my @ip = $res->nameservers($ns);
- $ns = [@ip]; # substitute IP list in situ
- next unless @ip;
+ @$ns = $res->nameservers($name);
+ next unless @$ns;
my $reply = $res->send($query) || next;
$res->{callback}->($reply) if $res->{callback};
return $reply;
@@ -177,6 +184,7 @@ sub send {
return;
}
+
sub query_dorecursion { &send; } ## historical
@@ -206,7 +214,7 @@ for queries for missing glue records.
sub callback {
my ( $self, $sub ) = @_;
- $self->{callback} = $sub if $sub && UNIVERSAL::isa( $sub, 'CODE' );
+ $self->{callback} = $sub if defined $sub && ref($sub) eq 'CODE';
return $self->{callback};
}
diff --git a/lib/Net/DNS/Text.pm b/lib/Net/DNS/Text.pm
index d8b42d8..52e001e 100644
--- a/lib/Net/DNS/Text.pm
+++ b/lib/Net/DNS/Text.pm
@@ -1,15 +1,15 @@
package Net::DNS::Text;
#
-# $Id: Text.pm 1235 2014-07-29 07:58:19Z willem $
+# $Id: Text.pm 1276 2014-10-19 06:02:40Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1235 $)[1];
+$VERSION = (qw$LastChangedRevision: 1276 $)[1];
=head1 NAME
-Net::DNS::Text - Domain Name System text representation
+Net::DNS::Text - DNS text representation
=head1 SYNOPSIS
@@ -53,9 +53,9 @@ use constant UTF8 => eval {
} || 0;
-# perlcc: eddress of encoding objects must be determined at runtime
-my $ascii = Encode::find_encoding('ascii') if ASCII; # Osborn's Law:
-my $utf8 = Encode::find_encoding('utf8') if UTF8; # Variables won't; constants aren't.
+# perlcc: address of encoding objects must be determined at runtime
+my $ascii = ASCII ? Encode::find_encoding('ascii') : undef; # Osborn's Law:
+my $utf8 = UTF8 ? Encode::find_encoding('utf8') : undef; # Variables won't; constants aren't.
=head1 METHODS
diff --git a/lib/Net/DNS/Update.pm b/lib/Net/DNS/Update.pm
index 4f6a1ef..6012418 100644
--- a/lib/Net/DNS/Update.pm
+++ b/lib/Net/DNS/Update.pm
@@ -1,15 +1,15 @@
package Net::DNS::Update;
#
-# $Id: Update.pm 1171 2014-02-26 08:56:52Z willem $
+# $Id: Update.pm 1272 2014-10-10 22:21:43Z willem $
#
use vars qw($VERSION @ISA);
-$VERSION = (qw$LastChangedRevision: 1171 $)[1];
+$VERSION = (qw$LastChangedRevision: 1272 $)[1];
=head1 NAME
-Net::DNS::Update - Create a DNS update packet
+Net::DNS::Update - DNS dynamic update packet
=head1 SYNOPSIS
@@ -27,15 +27,10 @@ making DNS dynamic updates.
Programmers should refer to RFC2136 for dynamic update semantics.
-WARNING: This code is still under development. Please use with
-caution on production nameservers.
-
=cut
use strict;
-use integer;
-
use base 'Net::DNS::Packet';
@@ -179,10 +174,6 @@ subsequent examples show only the creation of the update packet .
$update->push( update => rr_add('foo.example.com A 10.1.2.3') );
$update->push( additional => $tsig );
-=head1 BUGS
-
-This code is still under development. Please use with caution on
-production nameservers.
=head1 COPYRIGHT
diff --git a/lib/Net/DNS/ZoneFile.pm b/lib/Net/DNS/ZoneFile.pm
index 2ff6460..3483502 100644
--- a/lib/Net/DNS/ZoneFile.pm
+++ b/lib/Net/DNS/ZoneFile.pm
@@ -1,10 +1,10 @@
package Net::DNS::ZoneFile;
#
-# $Id: ZoneFile.pm 1235 2014-07-29 07:58:19Z willem $
+# $Id: ZoneFile.pm 1277 2014-10-20 07:46:37Z willem $
#
use vars qw($VERSION);
-$VERSION = (qw$LastChangedRevision: 1235 $)[1];
+$VERSION = (qw$LastChangedRevision: 1277 $)[1];
=head1 NAME
@@ -548,7 +548,7 @@ sub _include { ## open $INCLUDE file
my $file = _filename(shift);
my $root = shift;
- my @discipline = ( join ':', '<', PerlIO::get_layers $self->{handle} ) if PERLIO;
+ my @discipline = PERLIO ? ( join ':', '<', PerlIO::get_layers $self->{handle} ) : ();
my $handle = new FileHandle( $file, @discipline ) or croak qq(open: "$file" $!);
delete $self->{latest}; # forbid empty owner field
diff --git a/t/05-TSIG.t b/t/05-TSIG.t
index 44088ac..109caa0 100644
--- a/t/05-TSIG.t
+++ b/t/05-TSIG.t
@@ -1,4 +1,4 @@
-# $Id: 05-TSIG.t 1136 2013-12-10 14:30:00Z willem $ -*-perl-*-
+# $Id: 05-TSIG.t 1279 2014-10-24 08:12:21Z willem $ -*-perl-*-
use strict;
@@ -59,11 +59,12 @@ my $hash = {};
my $null = new Net::DNS::RR("$name NULL")->encode;
my $empty = new Net::DNS::RR("$name $type")->encode;
- my $rxbin = decode Net::DNS::RR( \$empty )->encode;
+ my $buffer = $empty; ## Note: TSIG RR gets destroyed by decoder
+ my $rxbin = decode Net::DNS::RR( \$buffer )->encode;
my $packet = Net::DNS::Packet->new( $name, 'TKEY', 'IN' );
$packet->header->id(1234); # fix packet id
- my $encoded = $rr->encode( 0, {}, $packet );
- my $decoded = decode Net::DNS::RR( \$encoded );
+ my $encoded = $buffer = $rr->encode( 0, {}, $packet );
+ my $decoded = decode Net::DNS::RR( \$buffer );
my $hex1 = unpack 'H*', $encoded;
my $hex2 = unpack 'H*', $decoded->encode;
my $hex3 = unpack 'H*', substr( $encoded, length $null );
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dns-perl.git
More information about the Pkg-perl-cvs-commits
mailing list