Version in base suite: 1.50-1 Base version: libnet-dns-perl_1.50-1 Target version: libnet-dns-perl_1.56-0+deb13u1 Base file: /srv/ftp-master.debian.org/ftp/pool/main/libn/libnet-dns-perl/libnet-dns-perl_1.50-1.dsc Target file: /srv/ftp-master.debian.org/policy/pool/main/libn/libnet-dns-perl/libnet-dns-perl_1.56-0+deb13u1.dsc Changes | 60 +++++++ MANIFEST | 1 META.json | 2 META.yml | 2 debian/changelog | 9 + lib/Net/DNS.pm | 6 lib/Net/DNS/DomainName.pm | 11 - lib/Net/DNS/Header.pm | 12 + lib/Net/DNS/Parameters.pm | 67 +++++--- lib/Net/DNS/RR.pm | 52 +++--- lib/Net/DNS/RR/CERT.pm | 6 lib/Net/DNS/RR/DELEG.pm | 331 ++++++++++++++++++++++++++++++++++++++++--- lib/Net/DNS/RR/DNSKEY.pm | 31 +++- lib/Net/DNS/RR/DS.pm | 10 - lib/Net/DNS/RR/OPT.pm | 8 - lib/Net/DNS/RR/RRSIG.pm | 45 ++--- lib/Net/DNS/RR/SIG.pm | 30 ++- lib/Net/DNS/RR/SVCB.pm | 148 +++++++++---------- lib/Net/DNS/RR/TKEY.pm | 6 lib/Net/DNS/Resolver.pm | 4 lib/Net/DNS/Resolver/Base.pm | 74 ++++----- lib/Net/DNS/Resolver/UNIX.pm | 24 ++- lib/Net/DNS/Text.pm | 4 lib/Net/DNS/Update.pm | 10 - t/01-resolver-config.t | 4 t/01-resolver.t | 10 - t/02-domainname.t | 7 t/03-parameters.t | 6 t/03-rr.t | 55 +++---- t/04-packet.t | 21 +- t/05-DELEG.t | 100 ++++++++++++ t/05-DNSKEY.t | 5 t/05-NULL.t | 3 t/05-SVCB.t | 132 +++++++++++------ t/08-IPv4.t | 55 ++----- t/08-IPv6.t | 55 ++----- t/08-recurse.t | 4 t/TestToolkit.pm | 4 38 files changed, 974 insertions(+), 440 deletions(-) dpkg-source: warning: cannot verify inline signature for /srv/release.debian.org/tmp/tmpymkyis37/libnet-dns-perl_1.50-1.dsc: no acceptable signature found dpkg-source: warning: cannot verify inline signature for /srv/release.debian.org/tmp/tmpymkyis37/libnet-dns-perl_1.56-0+deb13u1.dsc: no acceptable signature found diff -Nru libnet-dns-perl-1.50/Changes libnet-dns-perl-1.56/Changes --- libnet-dns-perl-1.50/Changes 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/Changes 2026-07-17 10:09:44.000000000 +0000 @@ -1,4 +1,62 @@ -$Id: Changes 2015 2025-02-21 08:37:21Z willem $ -*-text-*- +$Id: Changes 2058 2026-07-17 10:09:31Z willem $ -*-text-*- + + +**** 1.56 Jul 18, 2027 + +Fix rt.cpan.org #180088 + Documentation issue for Net::DNS::RR::RRSIG::verify() + +Fix rt.cpan.org #179946 + Denial of Service via long DNS compression chains + +Fix rt.cpan.org #179945 + Remote code injection via EDNS EXTENDED ERROR + +Fix rt.cpan.org #179692/#176900 + UNIX.pm: Unreachable code warning using Apache/mod_perl + + +**** 1.55 Jun 11, 2026 + + Fix UDP truncation tests which relied on large RSA RRSIGs. + +Fix rt.cpan.org #178183 + Unhelpful TAINT error + +Fix rt.cpan.org #177003 + TCP read loop treats 1-byte recv() of "0" (0x30) as EOF, corrupting AXFRs + +Fix rt.cpan.org #176900 + UNIX.pm: avoid `backticks` which depends on shell + + +**** 1.54 Jan 16, 2026 + + Resync with IANA DNS parameters registry. + Resync with IANA DNSSEC algorithms registry. + Backport DELEG parser to SVCB. + + +**** 1.53 Aug 29, 2025 + + Suppress autovivified undefined $rr->{class} and $rr->{ttl}. + Rework test scripts for SVCB and DELEG. + + +**** 1.52 Jul 29, 2025 + + Refactor SVCB to avoid internal use of generic keyNN. + DELEG documentation and code improvement. + +Fix rt.cpan.org #168433 + Bug in resolver base selection on non-Unix/Linux platforms + + +**** 1.51 Jul 4, 2025 + + Resync with IANA DNS Parameters registry. + Add prototype DELEG RR package. + Minor code and documentation improvements. **** 1.50 Feb 21, 2025 diff -Nru libnet-dns-perl-1.50/MANIFEST libnet-dns-perl-1.56/MANIFEST --- libnet-dns-perl-1.50/MANIFEST 2025-02-21 08:37:43.000000000 +0000 +++ libnet-dns-perl-1.56/MANIFEST 2026-07-17 10:10:11.000000000 +0000 @@ -136,6 +136,7 @@ t/05-CERT.t t/05-CNAME.t t/05-CSYNC.t +t/05-DELEG.t t/05-DHCID.t t/05-DNAME.t t/05-DNSKEY.t diff -Nru libnet-dns-perl-1.50/META.json libnet-dns-perl-1.56/META.json --- libnet-dns-perl-1.50/META.json 2025-02-21 08:37:43.000000000 +0000 +++ libnet-dns-perl-1.56/META.json 2026-07-17 10:10:11.000000000 +0000 @@ -79,6 +79,6 @@ } }, "release_status" : "stable", - "version" : "1.50", + "version" : "1.56", "x_serialization_backend" : "JSON::PP version 4.16" } diff -Nru libnet-dns-perl-1.50/META.yml libnet-dns-perl-1.56/META.yml --- libnet-dns-perl-1.50/META.yml 2025-02-21 08:37:43.000000000 +0000 +++ libnet-dns-perl-1.56/META.yml 2026-07-17 10:10:11.000000000 +0000 @@ -55,5 +55,5 @@ perl: '5.008009' strict: '1.03' warnings: '1.0501' -version: '1.50' +version: '1.56' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -Nru libnet-dns-perl-1.50/debian/changelog libnet-dns-perl-1.56/debian/changelog --- libnet-dns-perl-1.50/debian/changelog 2025-03-01 21:36:27.000000000 +0000 +++ libnet-dns-perl-1.56/debian/changelog 2026-08-21 17:24:30.000000000 +0000 @@ -1,3 +1,12 @@ +libnet-dns-perl (1.56-0+deb13u1) trixie-security; urgency=high + + * Team upload. + * Import upstream version 1.56. + Includes fixes for CVE-2026-64193 and CVE-2026-64194. + (Closes: #1142503) + + -- Salvatore Bonaccorso Fri, 21 Aug 2026 19:24:30 +0200 + libnet-dns-perl (1.50-1) unstable; urgency=medium * Team upload. diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/DomainName.pm libnet-dns-perl-1.56/lib/Net/DNS/DomainName.pm --- libnet-dns-perl-1.50/lib/Net/DNS/DomainName.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/DomainName.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: DomainName.pm 2005 2025-01-28 13:22:10Z willem $)[2]; +our $VERSION = (qw$Id: DomainName.pm 2054 2026-07-10 09:37:11Z willem $)[2]; =head1 NAME @@ -79,8 +79,8 @@ my $self = bless {label => $label}, shift; my $buffer = shift; # reference to data buffer my $offset = shift || 0; # offset within buffer - my $linked = shift; # caller's compression index - my $cache = $linked; + my $cache = shift; # caller's compression index + my $depth = shift; # recursion depth $cache->{$offset} = $self; # hashed objectref by offset my $buflen = length $$buffer; @@ -100,10 +100,9 @@ } else { # compression pointer my $link = 0x3FFF & unpack( "\@$index n", $$buffer ); croak 'corrupt compression pointer' unless $link < $offset; - croak 'invalid compression pointer' unless $linked; + croak 'deep compression recursion' if $depth++ > 120; - # uncoverable condition false - $self->{origin} = $cache->{$link} ||= __PACKAGE__->decode( $buffer, $link, $cache ); + $self->{origin} = $cache->{$link} ||= __PACKAGE__->decode( $buffer, $link, $cache, $depth ); return wantarray ? ( $self, $index + 2 ) : $self; } } diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Header.pm libnet-dns-perl-1.56/lib/Net/DNS/Header.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Header.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Header.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: Header.pm 2002 2025-01-07 09:57:46Z willem $)[2]; +our $VERSION = (qw$Id: Header.pm 2042 2025-12-24 10:23:11Z willem $)[2]; =head1 NAME @@ -86,11 +86,12 @@ my $cd = $self->cd; my $do = $self->do; my $co = $self->co; + my $de = $self->de; return <<"QQ"; ;; id = $dispid ;; qr = $qr aa = $aa tc = $tc rd = $rd opcode = $opcode ;; ra = $ra z = $zz ad = $ad cd = $cd rcode = $rcode -;; do = $do co = $co +;; do = $do co = $co de = $de ;; qdcount = $qd ancount = $an ;; nscount = $ns arcount = $ar QQ @@ -376,7 +377,7 @@ =head1 EDNS Protocol Extensions -=head2 do, co +=head2 do, co, de print "DNSSEC_OK flag was ", $packet->header->do ? "not" : "", "set\n"; $packet->header->do(1); @@ -395,6 +396,11 @@ return $self->_ednsflag( 0x4000, @value ); } +sub de { + my ( $self, @value ) = @_; + return $self->_ednsflag( 0x2000, @value ); +} + =head2 Extended rcode diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Parameters.pm libnet-dns-perl-1.56/lib/Net/DNS/Parameters.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Parameters.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Parameters.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,13 +3,13 @@ ################################################ ## ## Domain Name System (DNS) Parameters -## (last updated 2024-12-10) +## (last updated 2026-07-06) ## ################################################ use strict; use warnings; -our $VERSION = (qw$Id: Parameters.pm 2002 2025-01-07 09:57:46Z willem $)[2]; +our $VERSION = (qw$Id: Parameters.pm 2054 2026-07-10 09:37:11Z willem $)[2]; use integer; use Carp; @@ -50,6 +50,10 @@ # Registry: Resource Record (RR) TYPEs my @typebyname = ( + DELEG => 65432, # draft-ietf-deleg-02 + DELEG => 61440, # draft-ietf-deleg-03 + DELEGPARAM => 65433, # draft-ietf-deleg-07 + DELEGI => 65433, # draft-ietf-deleg-03 A => 1, # RFC1035 NS => 2, # RFC1035 MD => 3, # RFC1035 @@ -114,7 +118,9 @@ ZONEMD => 63, # RFC8976 SVCB => 64, # RFC9460 HTTPS => 65, # RFC9460 - DSYNC => 66, # draft-ietf-dnsop-generalized-notify-03 + DSYNC => 66, # RFC9859 + HHIT => 67, # RFC9886 + BRID => 68, # RFC9886 SPF => 99, # RFC7208 UINFO => 100, # IANA-Reserved UID => 101, # IANA-Reserved @@ -126,7 +132,7 @@ LP => 107, # RFC6742 EUI48 => 108, # RFC7043 EUI64 => 109, # RFC7043 - NXNAME => 128, # draft-ietf-dnsop-compact-denial-of-existence-04 + NXNAME => 128, # RFC9824 TKEY => 249, # RFC2930 TSIG => 250, # RFC8945 IXFR => 251, # RFC1995 @@ -197,24 +203,30 @@ # Registry: DNS EDNS0 Option Codes (OPT) my @ednsoptionbyname = ( - LLQ => 1, # RFC8764 - 'UPDATE-LEASE' => 2, # RFC-ietf-dnssd-update-lease-08 - NSID => 3, # RFC5001 - DAU => 5, # RFC6975 - DHU => 6, # RFC6975 - N3U => 7, # RFC6975 - 'CLIENT-SUBNET' => 8, # RFC7871 - EXPIRE => 9, # RFC7314 - COOKIE => 10, # RFC7873 - 'TCP-KEEPALIVE' => 11, # RFC7828 - PADDING => 12, # RFC7830 - CHAIN => 13, # RFC7901 - 'KEY-TAG' => 14, # RFC8145 - 'EXTENDED-ERROR' => 15, # RFC8914 - 'CLIENT-TAG' => 16, # draft-bellis-dnsop-edns-tags-01 - 'SERVER-TAG' => 17, # draft-bellis-dnsop-edns-tags-01 - 'REPORT-CHANNEL' => 18, # RFC9567 - ZONEVERSION => 19, # RFC9660 + LLQ => 1, # RFC8764 + 'UPDATE-LEASE' => 2, # RFC9664 + NSID => 3, # RFC5001 + DAU => 5, # RFC6975 + DHU => 6, # RFC6975 + N3U => 7, # RFC6975 + 'CLIENT-SUBNET' => 8, # RFC7871 + EXPIRE => 9, # RFC7314 + COOKIE => 10, # RFC7873 + 'TCP-KEEPALIVE' => 11, # RFC7828 + PADDING => 12, # RFC7830 + CHAIN => 13, # RFC7901 + 'KEY-TAG' => 14, # RFC8145 + 'EXTENDED-ERROR' => 15, # RFC8914 + 'CLIENT-TAG' => 16, # draft-bellis-dnsop-edns-tags-01 + 'SERVER-TAG' => 17, # draft-bellis-dnsop-edns-tags-01 + 'REPORT-CHANNEL' => 18, # RFC9567 + ZONEVERSION => 19, # RFC9660 + 'MQTYPE-QUERY' => 20, # RFC-ietf-dnssd-multi-qtypes-14 + 'MQTYPE-RESPONSE' => 21, # RFC-ietf-dnssd-multi-qtypes-14 + 'EDE-EXTRA-TEXT-LANGUAGE' => 22, # draft-muks-dns-filtering-05 + 'FILTERING-CONTACT' => 23, # draft-muks-dns-filtering-05 + 'FILTERING-ORGANIZATION' => 24, # draft-muks-dns-filtering-05 + 'FILTERING-DB' => 25, # draft-muks-dns-filtering-05 'UMBRELLA-IDENT' => 20292, # https://developer.cisco.com/docs/cloud-security/#!integrating-network-devic DEVICEID => 26946, # https://developer.cisco.com/docs/cloud-security/#!network-devices-getting-s ); @@ -239,6 +251,7 @@ # Registry: EDNS Header Flags (16 bits) my @ednsflagbyname = ( DO => 0x8000, # RFC4035 RFC3225 RFC6840 + CO => 0x4000, # RFC9824 ); push @ednsflagbyname, map { /^\d/ ? $_ : lc($_) } @ednsflagbyname; our %ednsflagbyname = @ednsflagbyname; @@ -291,7 +304,11 @@ 27 => 'Unsupported NSEC3 Iterations Value', # RFC9276 28 => 'Unable to conform to policy', # draft-homburg-dnsop-codcp-00 29 => 'Synthesized', # https://github.com/PowerDNS/pdns/pull/12334 - 30 => 'Invalid Query Type', # draft-ietf-dnsop-compact-denial-of-existence-04 + 30 => 'Invalid Query Type', # RFC9824 + 31 => 'Rate Limited', # draft-muks-dns-ede-rate-limited-02 + 32 => 'Over Quota', # draft-muks-dns-ede-rate-limited-02 + 33 => 'Negative Trust Anchor', # draft-farrokhi-dnsop-ede-nta-00 + 34 => 'New Delegation Only', # draft-ietf-deleg-10 ); our %dnserrorbyval = @dnserrorbyval; @@ -410,8 +427,8 @@ sub _typespec { my $generate = defined wantarray; return EXTLANG ? eval <<'END' : ''; ## no critic - my ($node) = @_; ## draft-levine-dnsextlang - my $instance = Net::DNS::Extlang->new(); + my ($node) = @_; + my $instance = Net::DNS::Extlang->new(); ## draft-levine-dnsextlang my $basename = $instance->domain || return ''; require Net::DNS::Resolver; diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/CERT.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/CERT.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/CERT.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/CERT.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: CERT.pm 2002 2025-01-07 09:57:46Z willem $)[2]; +our $VERSION = (qw$Id: CERT.pm 2042 2025-12-24 10:23:11Z willem $)[2]; use base qw(Net::DNS::RR); @@ -141,8 +141,8 @@ 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] - 'SM2SM3' => 17, # [RFC-cuiling-dnsop-sm2-alg-15] - 'ECC-GOST12' => 23, # [RFC-makarenko-gost2012-dnssec-05] + 'SM2SM3' => 17, # [RFC9563] + 'ECC-GOST12' => 23, # [RFC9558] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/DELEG.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/DELEG.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/DELEG.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/DELEG.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,9 +2,9 @@ use strict; use warnings; -our $VERSION = (qw$Id: DELEG.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: DELEG.pm 2053 2026-07-07 10:18:23Z willem $)[2]; -use base qw(Net::DNS::RR::SVCB); +use base qw(Net::DNS::RR); =head1 NAME @@ -13,6 +13,271 @@ =cut +use integer; + +use Net::DNS::RR::A; +use Net::DNS::RR::AAAA; +use Net::DNS::DomainName; +use Net::DNS::Text; + +my %keybycode = ( + 0 => 'mandatory', + 1 => 'server-ipv4', + 2 => 'server-ipv6', + 3 => 'server-name', + 4 => 'include-delegparam', + ); +my %keybyname = reverse %keybycode; + + +sub _decode_rdata { ## decode rdata from wire-format octet string + my ( $self, $data, $offset ) = @_; + + my $limit = $self->{rdlength}; + my $rdata = $self->{rdata} = substr $$data, $offset, $limit; + my $index = 0; + + my $params = $self->{parameters} = []; + while ( ( my $start = $index + 4 ) <= $limit ) { + my ( $key, $size ) = unpack( "\@$index n2", $rdata ); + last if ( $index = $start + $size ) > $limit; + push @$params, ( $key, substr $rdata, $start, $size ); + } + die $self->type . ': corrupt RDATA' unless $index == $limit; + return; +} + + +sub _encode_rdata { ## encode rdata as wire-format octet string + my $self = shift; + + my @packed; + my ($paramref) = grep {defined} $self->{parameters}, []; + my @parameters = @$paramref; + while (@parameters) { + my $key = shift @parameters; + my $val = shift @parameters; + push @packed, pack( 'n2a*', $key, length($val), $val ); + } + return join '', @packed; +} + + +sub _format_rdata { ## format rdata portion of RR string. + my $self = shift; + + my @rdata; + my ($paramref) = grep {defined} $self->{parameters}, []; + my @parameters = @$paramref; + while (@parameters) { + my $key = shift @parameters; + my $val = shift @parameters; + if ( my $name = $keybycode{$key} ) { + my @val = grep {length} $self->$name; + s/,/\\044/g foreach @val; # escape embedded commas + my @rhs = grep {length} join ',', @val; + push @rdata, join '=', $name, @rhs; + } else { + my $txt = Net::DNS::Text->decode( \$val, 0, length $val ); + push @rdata, join '=', "key$key", $txt->string; + } + } + + return @rdata; +} + + +sub _parse_rdata { ## populate RR from rdata in argument list + my ( $self, @argument ) = @_; + + while ( local $_ = shift @argument ) { + m/^([^=]+)(=?)(.*)$/; + my $key = $1; + my $val = length($3) ? $3 : $2 ? shift @argument : ''; + if (/^key\d+/) { + $self->$key($val); + } else { + local $_ = $val; + s/^"([^"]*)"$/$1/s; # strip enclosing quotes + s/\\,/\\044/g; # disguise escaped comma + $self->$key( split /,/ ); + } + } + return; +} + + +sub _post_parse { ## parser post processing + my $self = shift; + + my ($paramref) = grep {defined} $self->{parameters}, []; + my %parameter = @$paramref; + + if ( defined $parameter{0} ) { + my %unique; + foreach ( grep { !$unique{$_}++ } unpack 'n*', $parameter{0} ) { + die( $self->type . qq[: unexpected "key0" in mandatory list] ) if $unique{0}; + die( $self->type . qq[: duplicate "key$_" in mandatory list] ) if --$unique{$_}; + die( $self->type . qq[: mandatory "key$_" not present] ) unless defined $parameter{$_}; + } + } + + foreach ( 3, 4 ) { + next unless defined $parameter{$_}; + next if length( $parameter{$_} ) > 1; + die( $self->type . qq[: invalid $keybycode{$_}] ); + } + + if ( defined $parameter{4} ) { + die( $self->type . qq[: parameter conflicts with $keybycode{4}] ) + if scalar( keys %parameter ) > 1; + } + return; +} + + +sub mandatory { ## mandatory=key1,server-name,... + my ( $self, @value ) = @_; # uncoverable pod + my @list = map { $keybyname{lc $_} || $_ } @value; + my @keys = map { /(\d+)$/ ? $1 : die( $self->type . qq[: unexpected "$_"] ) } @list; + return $self->_parameter( 0, _integer16( sort { $a <=> $b } @keys ) ) if @keys; + my $packed = $self->_parameter(0); + return _list( defined($packed) ? map {"key$_"} unpack 'n*', $packed : return ); +} + +sub server_ipv4 { ## server-ipv4=192.0.2.53 + my ( $self, @value ) = @_; + return $self->_parameter( 1, _address4(@value) ) if @value; + my $packed = $self->_parameter(1) || return; + my @iplist = unpack 'a4' x ( length($packed) / 4 ), $packed; + return _list( map { Net::DNS::RR::A::address( {address => $_} ) } @iplist ); +} + +sub server_ipv6 { ## server-ipv6=2001:DB8::53 + my ( $self, @value ) = @_; + return $self->_parameter( 2, _address6(@value) ) if @value; + my $packed = $self->_parameter(2) || return; + my @iplist = unpack 'a16' x ( length($packed) / 16 ), $packed; + return _list( map { Net::DNS::RR::AAAA::address_short( {address => $_} ) } @iplist ); +} + +sub server_name { ## server-name=nameserver.example + my ( $self, @value ) = @_; + return $self->_parameter( 3, _domain(@value) ) if @value; + my $packed = $self->_parameter(3) || return; + my $index = 0; + ( $value[++$#value], $index ) = Net::DNS::DomainName->decode( \$packed, $index ) while $index < length $packed; + return _list( map { $_->fqdn } @value ); +} + +sub include_delegparam { ## include-delegparam=provider.example + my ( $self, @value ) = @_; + return $self->_parameter( 4, _domain(@value) ) if @value; + my $packed = $self->_parameter(4) || return; + my $index = 0; + ( $value[++$#value], $index ) = Net::DNS::DomainName->decode( \$packed, $index ) while $index < length $packed; + return _list( map { $_->fqdn } @value ); +} + + +######################################## + +sub AUTOLOAD { ## Dynamic constructor/accessor methods + my ( $self, @argument ) = @_; + + our $AUTOLOAD; + my ($method) = reverse split /::/, $AUTOLOAD; + my $canonical = lc($method); + $canonical =~ s/-/_/g; + if ( $self->can($canonical) ) { + no strict 'refs'; ## no critic ProhibitNoStrict + *{$AUTOLOAD} = sub { shift->$canonical(@_) }; + return $self->$canonical(@argument); + } + + my $super = "SUPER::$method"; + return $self->$super(@argument) unless $method =~ /^key[0]*(\d+)$/i; + my $key = $1; + return $self->_parameter($key) unless @argument; + my $first = shift @argument; + my $value = defined $first ? Net::DNS::Text->new($first)->raw : $first; + return $self->_parameter( $key, $value, @argument ); +} + + +sub _parameter { + my ( $self, $key, @argument ) = @_; + + my ($paramref) = grep {defined} $self->{parameters}, []; + my %parameter = @$paramref; + + if ( scalar @argument ) { + my $arg = shift @argument; # key($value); + delete $parameter{$key} unless defined $arg; + die( $self->type . qq[: duplicate parameter key$key] ) if defined $parameter{$key}; + die( $self->type . qq[: unexpected key$key value] ) if scalar @argument; + delete $self->{rdata}; + $parameter{$key} = $arg if defined $arg; + $self->{parameters} = [map { ( $_, $parameter{$_} ) } sort { $a <=> $b } keys %parameter]; + } + + return $parameter{$key}; +} + + +sub _concatenate { ## concatenate octet string(s) + my @arg = @_; + return scalar(@arg) > 1 ? join( '', @arg ) : @arg; +} + +sub _list { ## context-dependent list or single value + my @arg = @_; + return wantarray ? @arg : shift @arg; +} + +sub _address4 { + my @arg = @_; + return _concatenate( map { Net::DNS::RR::A::address( {}, $_ ) } @arg ); +} + +sub _address6 { + my @arg = @_; + return _concatenate( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @arg ); +} + +sub _domain { + my @arg = @_; + return _concatenate( map { Net::DNS::DomainName->new($_)->encode() } @arg ); +} + +sub _integer16 { + my @arg = @_; + return _concatenate( map { pack( 'n', $_ ) } @arg ); +} + + +sub generic { + my $self = shift; + my $size = 0; + my @rdata; + my ($paramref) = grep {defined} $self->{parameters}, []; + my @parameters = @$paramref; + while (@parameters) { + my $key = shift @parameters; + my $val = shift @parameters; + push @rdata, "\n", unpack 'H4H4', pack( 'n2', $key, length $val ); + $size += 4 + length $val; + push @rdata, split /(\S{32})/, unpack 'H*', $val; + } + + my @ttl = grep {defined} $self->{ttl}; + my @class = map { $_ ? "CLASS$_" : () } $self->{class}; + my @core = ( $self->{owner}->string, @ttl, @class, "TYPE$self->{type}" ); + return join "\n\t", Net::DNS::RR::_wrap( "@core ( \\# $size", @rdata, ')' ); +} + +######################################## + 1; __END__ @@ -21,22 +286,19 @@ =head1 SYNOPSIS use Net::DNS; - $rr = Net::DNS::RR->new('alias DELEG 0 target'); - $rr = Net::DNS::RR->new('child DELEG 1 nameserver ipv6hint=2001:db8::f00'); + $rr = Net::DNS::RR->new('zone DELEG server-ipv4=192.0.2.1 ...'); + $rr = Net::DNS::RR->new('zone DELEG server-ipv6=2001:db8::53 ...'); + $rr = Net::DNS::RR->new('zone DELEG server-name=nameserver.example ...'); + $rr = Net::DNS::RR->new('zone DELEG include-delegparam=provider.example'); =head1 DESCRIPTION -DNS DELEG resource record +The DNS DELEG resource record set, wherever it appears, designates the +authoritative nameservers and transport parameters to be used to resolve +queries for data at the owner name or any subordinate thereof. -The DELEG record appears in, and is logically a part of, -the parent zone to mark the delegation point for a child zone. -It advertises, directly or indirectly, transport methods -available for connection to nameservers serving the child zone. - -The DELEG class is derived from, and inherits all properties of, -the Net::DNS::RR::SVCB class. - -Please see the L documentation for details. +The DELEG RRset is authoritative data within the delegating zone. +A DELEG RRset must not appear at the apex of a delegated zone. =head1 METHODS @@ -48,10 +310,45 @@ other unpredictable behaviour. +=head2 server_ipv4 + + eg.example. DELEG server-ipv4=192.0.2.1,... + @ip = $rr->server_ipv4; + +Sets or gets a list of IP addresses. + + +=head2 server_ipv6 + + eg.example. DELEG server-ipv6=2001:db8::53,... + @ip = $rr->server_ipv6; + +Sets or gets a list of IP addresses. + + +=head2 server_name + + eg.example. DELEG server-name=nameserver.example. + $nameserver = $rr->server_name; + +Specifies the domain name of the nameserver. + +Returns the nameserver domain name or the undefined value if not specified. + + +=head2 include_delegparam + + eg.example. DELEG include-delegparam=provider.example. + $destination = $rr->include_delegparam; + +Specifies the location of a devolved nameserver configuration. + +Returns the destination domain name or the undefined value if not specified. + =head1 COPYRIGHT -Copyright (c)2024 Dick Franks. +Copyright (c)2025-2026 Dick Franks. All rights reserved. @@ -80,8 +377,6 @@ =head1 SEE ALSO L L L -L - -L +draft-ietf-deleg-10 =cut diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/DNSKEY.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/DNSKEY.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/DNSKEY.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/DNSKEY.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: DNSKEY.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: DNSKEY.pm 2042 2025-12-24 10:23:11Z willem $)[2]; use base qw(Net::DNS::RR); @@ -103,6 +103,17 @@ } +sub adt { + my ( $self, @value ) = @_; + if ( scalar @value ) { + for ( $self->{flags} |= 0x0002 ) { + $_ ^= 0x0002 unless shift @value; + } + } + return $self->{flags} & 0x0002; +} + + sub sep { my ( $self, @value ) = @_; if ( scalar @value ) { @@ -237,8 +248,8 @@ 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] - 'SM2SM3' => 17, # [RFC-cuiling-dnsop-sm2-alg-15] - 'ECC-GOST12' => 23, # [RFC-makarenko-gost2012-dnssec-05] + 'SM2SM3' => 17, # [RFC9563] + 'ECC-GOST12' => 23, # [RFC9558] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] @@ -328,6 +339,20 @@ =back +=over 4 + +=item adt + + $rr->adt(1); + + if ( $rr->adt ) { + ... + } + +Authoritative Delegation Types (ADT) flag. + +=back + =over 4 =item sep diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/DS.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/DS.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/DS.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/DS.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: DS.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: DS.pm 2042 2025-12-24 10:23:11Z willem $)[2]; use base qw(Net::DNS::RR); @@ -174,8 +174,8 @@ 'SHA-256' => 2, # [RFC4509] 'GOST-R-34.11-94' => 3, # [RFC5933] 'SHA-384' => 4, # [RFC6605] - 'GOST-R-34.11-2012' => 5, # [RFC-makarenko-gost2012-dnssec-05] - 'SM3' => 6, # [RFC-cuiling-dnsop-sm2-alg-15] + 'GOST-R-34.11-2012' => 5, # [RFC9558] + 'SM3' => 6, # [RFC9563] ); my @digestalias = ( 'SHA' => 1 ); @@ -221,8 +221,8 @@ 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] - 'SM2SM3' => 17, # [RFC-cuiling-dnsop-sm2-alg-15] - 'ECC-GOST12' => 23, # [RFC-makarenko-gost2012-dnssec-05] + 'SM2SM3' => 17, # [RFC9563] + 'ECC-GOST12' => 23, # [RFC9558] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/OPT.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/OPT.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/OPT.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/OPT.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: OPT.pm 2005 2025-01-28 13:22:10Z willem $)[2]; +our $VERSION = (qw$Id: OPT.pm 2054 2026-07-10 09:37:11Z willem $)[2]; use base qw(Net::DNS::RR); @@ -99,8 +99,7 @@ sub generic { ## override RR method my $self = shift; local $self->{class} = $self->udpsize; - my @xttl = ( $self->rcode >> 4, $self->version, $self->flags ); - local $self->{ttl} = unpack 'N', pack( 'C2n', @xttl ); + local $self->{ttl} = $self->_ttl; return $self->SUPER::generic; } @@ -452,6 +451,7 @@ my $extra = Net::DNS::Text->decode( \$text, 0, length $text ); for ( $extra->value ) { last unless /^[\[\{]/; + s/[`]([^`]*)[`]/$1/g; ## suppress backticks s/([\$\@])/\\$1/g; ## Here be dragons! my $REGEX = q/("[^"]*"|[\[\]{}:,]|[-0-9.Ee+]+)|\s+|(.)/; my @split = grep { defined && length } split /$REGEX/o; @@ -636,7 +636,7 @@ Copyright (c)2001,2002 RIPE NCC. Author Olaf M. Kolkman. -Portions Copyright (c)2012,2017-2024 Dick Franks. +Portions Copyright (c)2012,2017-2026 Dick Franks. All rights reserved. diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/RRSIG.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/RRSIG.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/RRSIG.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/RRSIG.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: RRSIG.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: RRSIG.pm 2057 2026-07-16 10:05:04Z willem $)[2]; use base qw(Net::DNS::RR); @@ -29,20 +29,22 @@ ## IMPORTANT: MUST NOT include crypto packages in metadata (strong crypto prohibited in many territories) use constant DNSSEC => defined $INC{'Net/DNS/SEC.pm'}; ## Discover how we got here, without exposing any crypto -my @index; +my @algorithms; +my @deprecated; if (DNSSEC) { - foreach my $class ( map {"Net::DNS::SEC::$_"} qw(Private RSA DSA ECDSA EdDSA Digest SM2) ) { - my @algorithms = eval join '', qw(r e q u i r e), " $class; ${class}::_index()"; ## no critic - push @index, map { ( $_ => $class ) } @algorithms; + foreach my $class ( map {"Net::DNS::SEC::$_"} qw(Private DSA RSA ECDSA EdDSA Digest SM2) ) { + my @index = eval join '', qw(r e q u i r e), " $class; ${class}::_index()"; ## no critic + push @algorithms, map { ( $_ => $class ) } @index; + push @deprecated, eval "${class}::_deprecate()"; ## no critic } - croak 'Net::DNS::SEC version not supported' unless scalar(@index); + croak 'Net::DNS::SEC version not supported' unless scalar(@algorithms); } -my %DNSSEC_verify = @index; -my %DNSSEC_siggen = @index; +my %DNSSEC_verify = @algorithms; +my %DNSSEC_siggen = @algorithms; -my @deprecated = ( 1, 3, 6, 12 ); # RFC8624 -delete @DNSSEC_siggen{@deprecated}; +delete @DNSSEC_verify{@deprecated}; ## DNSSEC status per RFC9904 +delete @DNSSEC_siggen{map { abs($_) } @deprecated}; my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); @@ -349,8 +351,8 @@ 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] - 'SM2SM3' => 17, # [RFC-cuiling-dnsop-sm2-alg-15] - 'ECC-GOST12' => 23, # [RFC-makarenko-gost2012-dnssec-05] + 'SM2SM3' => 17, # [RFC9563] + 'ECC-GOST12' => 23, # [RFC9558] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] @@ -570,8 +572,8 @@ use Net::DNS::SEC; $sigrr = Net::DNS::RR::RRSIG->create( \@rrset, $keypath, - sigex => 20241230010101, - sigin => 20241201010101 + sigex => 20251230010101, + sigin => 20251201010101 ); $sigrr->verify( \@rrset, $keyrr ) || die $sigrr->vrfyerrstr; @@ -696,8 +698,8 @@ $sigrr = Net::DNS::RR::RRSIG->create( \@rrsetref, $keypath, - sigex => 20241230010101, - sigin => 20241201010101 + sigex => 20251230010101, + sigin => 20251201010101 ); $sigrr->print; @@ -723,8 +725,8 @@ The optional remaining arguments consist of ( name => value ) pairs as follows: - sigex => 20241230010101, # signature expiration - sigin => 20241201010101, # signature inception + sigex => 20251230010101, # signature expiration + sigin => 20251201010101, # signature inception sigval => 30, # validity window (days) ttl => 3600 @@ -748,7 +750,7 @@ method verifies the RRset against the signature contained in the $sigrr object itself using the public key in $keyrr. -The second argument can either be a Net::DNS::RR::KEYRR object or a +The second argument can either be a Net::DNS::RR::DNSKEY object or a reference to an array of such objects. Verification will return successful as soon as one of the keys in the array leads to positive validation. @@ -799,9 +801,6 @@ Dick Franks added support for elliptic curve and Edwards curve algorithms. -Mike McCauley created the Crypt::OpenSSL::ECDSA perl extension module -specifically for this development. - =head1 COPYRIGHT @@ -809,7 +808,7 @@ Copyright (c)2007-2008 NLnet Labs, Olaf M. Kolkman -Portions Copyright (c)2014 Dick Franks +Portions Copyright (c)2014,2025 Dick Franks All rights reserved. diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/SIG.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/SIG.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/SIG.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/SIG.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: SIG.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: SIG.pm 2057 2026-07-16 10:05:04Z willem $)[2]; use base qw(Net::DNS::RR); @@ -29,17 +29,19 @@ ## IMPORTANT: MUST NOT include crypto packages in metadata (strong crypto prohibited in many territories) use constant DNSSEC => defined $INC{'Net/DNS/SEC.pm'}; ## Discover how we got here, without exposing any crypto -my @index; +my @algorithms; +my @deprecated; if (DNSSEC) { - foreach my $class ( map {"Net::DNS::SEC::$_"} qw(Private RSA DSA ECDSA EdDSA Digest SM2) ) { - my @algorithms = eval join '', qw(r e q u i r e), " $class; ${class}::_index()"; ## no critic - push @index, map { ( $_ => $class ) } @algorithms; + foreach my $class ( map {"Net::DNS::SEC::$_"} qw(Private DSA RSA ECDSA EdDSA Digest SM2) ) { + my @index = eval join '', qw(r e q u i r e), " $class; ${class}::_index()"; ## no critic + push @algorithms, map { ( $_ => $class ) } @index; + push @deprecated, eval "${class}::_deprecate()"; ## no critic } - croak 'Net::DNS::SEC version not supported' unless scalar(@index); + croak 'Net::DNS::SEC version not supported' unless scalar(@algorithms); } -my %DNSSEC_verify = @index; -my %DNSSEC_siggen = @index; +my %DNSSEC_verify = @algorithms; +my %DNSSEC_siggen = @algorithms; my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); @@ -349,8 +351,8 @@ 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] - 'SM2SM3' => 17, # [RFC-cuiling-dnsop-sm2-alg-15] - 'ECC-GOST12' => 23, # [RFC-makarenko-gost2012-dnssec-05] + 'SM2SM3' => 17, # [RFC9563] + 'ECC-GOST12' => 23, # [RFC9558] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] @@ -676,8 +678,8 @@ The optional remaining arguments consist of ( name => value ) pairs as follows: - sigin => 20241201010101, # signature inception - sigex => 20241201011101, # signature expiration + sigin => 20251201010101, # signature inception + sigex => 20251201011101, # signature expiration sigval => 10, # validity window (minutes) The sigin and sigex values may be specified as Perl time values or as @@ -701,7 +703,7 @@ If a reference to a Net::DNS::Packet is supplied, the method performs a SIG0 verification on the packet data. -The second argument can either be a Net::DNS::RR::KEYRR object or a +The second argument can either be a Net::DNS::RR::KEY object or a reference to an array of such objects. Verification will return successful as soon as one of the keys in the array leads to positive validation. @@ -749,6 +751,8 @@ T.J. Mather provided support for the DSA algorithm. +Dick Franks added support for elliptic curve and Edwards curve algorithms. + =head1 COPYRIGHT diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/SVCB.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/SVCB.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/SVCB.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/SVCB.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: SVCB.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: SVCB.pm 2043 2026-01-14 13:35:59Z willem $)[2]; use base qw(Net::DNS::RR); @@ -35,11 +35,6 @@ 'tls-supported-groups' => 'key9', ); -my %boolean = ( - 'no-default-alpn' => 'key2', - ohttp => 'key8', - ); - sub _decode_rdata { ## decode rdata from wire-format octet string my ( $self, $data, $offset ) = @_; @@ -52,10 +47,8 @@ my $params = $self->{SvcParams} = []; while ( ( my $start = $offset + 4 ) <= $limit ) { my ( $key, $size ) = unpack( "\@$offset n2", $rdata ); - my $next = $start + $size; - last if $next > $limit; + last if ( $offset = $start + $size ) > $limit; push @$params, ( $key, substr $rdata, $start, $size ); - $offset = $next; } die $self->type . ': corrupt RDATA' unless $offset == $limit; return; @@ -87,7 +80,7 @@ my $length = 2 + length $encode; my @target = grep {length} split /(\S{32})/, unpack 'H*', $encode; my $target = substr $self->{TargetName}->string, 0, 40; - push @rdata, join '', shift(@target), "\t; $target\n"; + push @rdata, join '', shift(@target), "\t; $target\n" unless $target eq '.'; push @rdata, @target; my $params = $self->{SvcParams} || []; @@ -119,32 +112,21 @@ $self->svcpriority( shift @argument ); $self->targetname( shift @argument ); - local $SIG{__WARN__} = sub { die @_ }; - while ( my $svcparam = shift @argument ) { - for ($svcparam) { - my @value; - if (/^key\d+=(.*)$/i) { - local $_ = length($1) ? $1 : shift @argument; - s/^"([^"]*)"$/$1/; # strip enclosing quotes - push @value, $_; - } elsif (/^[^=]+=(.*)$/) { - local $_ = length($1) ? $1 : shift @argument; - die <<"Amen" if /\\092[,\\]/; + while ( local $_ = shift @argument ) { + m/^([^=]+)(=?)(.*)$/; + my $key = $1; + my $val = length($3) ? $3 : $2 ? shift @argument : ''; + if (/^key\d+/) { + $self->$key($val); + } else { + local $_ = $val; + die <<'RIP' if /\\092[,\\]/; SVCB: Please use standard RFC1035 escapes - RFC9460 double-escape nonsense not implemented -Amen - s/^"([^"]*)"$/$1/; # strip enclosing quotes - s/\\,/\\044/g; # disguise (RFC1035) escaped comma - push @value, split /,/; - } else { - push @value, '' unless $keybyname{$_}; # unregistered boolean key - } - - m/^([^=]+)/; # extract identifier - my $key = $1; - push @value, 1 if $boolean{$key}; - $key =~ s/[-]/_/g; - $self->$key(@value); + RFC9460 double-escape insanity not implemented +RIP + s/^"([^"]*)"$/$1/s; # strip enclosing quotes + s/\\,/\\044/g; # disguise (RFC1035) escaped comma + $self->$key( split /,/ ); } } return; @@ -183,114 +165,115 @@ sub svcpriority { my ( $self, @value ) = @_; # uncoverable pod for (@value) { $self->{SvcPriority} = 0 + $_ } - return $self->{SvcPriority} || 0; + return $self->{SvcPriority}; } sub targetname { my ( $self, @value ) = @_; # uncoverable pod - - for (@value) { $self->{TargetName} = Net::DNS::DomainName->new($_) } - + $self->{TargetName} = Net::DNS::DomainName->new(@value) if @value; my $target = $self->{TargetName} ? $self->{TargetName}->name : return; - return $target unless $self->{SvcPriority}; - return ( $target eq '.' ) ? $self->owner : $target; + return $target unless $target eq '.'; + return $self->{SvcPriority} ? $self->owner : undef; } sub mandatory { ## mandatory=key1,port,... my ( $self, @value ) = @_; - my @list = map { $keybyname{lc $_} || $_ } map { split /,/ } @value; + my @list = map { $keybyname{lc $_} || $_ } @value; my @keys = map { /(\d+)$/ ? $1 : die( $self->type . qq[: unexpected "$_"] ) } @list; - return $self->key0( _integer16( sort { $a <=> $b } @keys ) ); + return $self->_SvcParam( 0, _integer16( sort { $a <=> $b } @keys ) ); } sub alpn { ## alpn=h3,h2,... my ( $self, @value ) = @_; - return $self->key1( _string(@value) ); + return $self->_SvcParam( 1, _string(@value) ); } sub no_default_alpn { ## no-default-alpn (Boolean) my ( $self, @value ) = @_; # uncoverable pod - return $self->key2( _boolean(@value) ); + return $self->_SvcParam(2) if defined wantarray; + return $self->_SvcParam( 2, _boolean(@value) ); } sub port { ## port=1234 my ( $self, @value ) = @_; - return $self->key3( map { _integer16($_) } @value ); + return $self->_SvcParam( 3, map { _integer16($_) } @value ); } sub ipv4hint { ## ipv4hint=192.0.2.1,... my ( $self, @value ) = @_; - return $self->key4( _ipv4(@value) ); + return $self->_SvcParam( 4, _address4(@value) ); } sub ech { ## ech=base64 my ( $self, @value ) = @_; - return $self->key5( map { _base64($_) } @value ); + return $self->_SvcParam( 5, map { _base64($_) } @value ); } sub ipv6hint { ## ipv6hint=2001:DB8::1,... my ( $self, @value ) = @_; - return $self->key6( _ipv6(@value) ); + return $self->_SvcParam( 6, _address6(@value) ); } sub dohpath { ## dohpath=/dns-query{?dns} my ( $self, @value ) = @_; # uncoverable pod - return $self->key7(@value); + return $self->_SvcParam( 7, map { substr _string($_), 1 } @value ); } sub ohttp { ## ohttp my ( $self, @value ) = @_; # uncoverable pod - return $self->key8( _boolean(@value) ); + return $self->_SvcParam(8) if defined wantarray; + return $self->_SvcParam( 8, _boolean(@value) ); } sub tls_supported_groups { ## tls_supported_groups=29,23 my ( $self, @value ) = @_; # uncoverable pod - return $self->key9( _integer16(@value) ); + return $self->_SvcParam( 9, _integer16(@value) ); } ######################################## -sub _presentation { ## represent octet string(s) using local charset +sub _concatenate { ## concatenate octet string(s) my @arg = @_; - my $raw = scalar(@arg) ? join( '', @arg ) : return (); # concatenate arguments - return Net::DNS::Text->decode( \$raw, 0, length($raw) )->string; + return scalar(@arg) ? join( '', @arg ) : @arg; } sub _boolean { my @arg = @_; - return @arg unless scalar @arg; # read key - my $arg = shift @arg; - return $arg unless defined $arg; # delete key. - return ( $arg ? '' : undef, @arg ); # set key + return '' unless scalar @arg; + return map { $_ ? '' : undef } @arg; } sub _string { my @arg = @_; - return _presentation( map { Net::DNS::Text->new($_)->encode() } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { Net::DNS::Text->new($_)->encode() } @val ); } sub _base64 { my @arg = @_; - return _presentation( map { MIME::Base64::decode($_) } @arg ); + return _concatenate( map { MIME::Base64::decode($_) } @arg ); } sub _integer16 { my @arg = @_; - return _presentation( map { pack( 'n', $_ ) } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { pack( 'n', $_ ) } @val ); } -sub _ipv4 { +sub _address4 { my @arg = @_; - return _presentation( map { Net::DNS::RR::A::address( {}, $_ ) } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { Net::DNS::RR::A::address( {}, $_ ) } @val ); } -sub _ipv6 { +sub _address6 { my @arg = @_; - return _presentation( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @val ); } @@ -298,12 +281,29 @@ my ( $self, @argument ) = @_; our $AUTOLOAD; - my ($method) = reverse split /::/, $AUTOLOAD; + my ($method) = reverse split /::/, $AUTOLOAD; + my $canonical = lc($method); + $canonical =~ s/-/_/g; + if ( $self->can($canonical) ) { + no strict 'refs'; ## no critic ProhibitNoStrict + *{$AUTOLOAD} = sub { shift->$canonical(@_) }; + return $self->$canonical(@argument); + } my $super = "SUPER::$method"; return $self->$super(@argument) unless $method =~ /^key[0]*(\d+)$/i; my $key = $1; + return $self->_SvcParam($key) unless @argument; + my $first = shift @argument; + my $value = defined $first ? Net::DNS::Text->new($first)->raw : $first; + return $self->_SvcParam( $key, $value, @argument ); +} + + +sub _SvcParam { + my ( $self, $key, @argument ) = @_; + my $paramsref = $self->{SvcParams} || []; my %svcparams = @$paramsref; @@ -314,7 +314,7 @@ die( $self->type . qq[: invalid SvcParam "key$key"] ) if $key > 65534; die( $self->type . qq[: unexpected "key$key" value] ) if scalar @argument; delete $self->{rdata}; - $svcparams{$key} = Net::DNS::Text->new("$arg")->raw if defined $arg; + $svcparams{$key} = $arg if defined $arg; $self->{SvcParams} = [map { ( $_, $svcparams{$_} ) } sort { $a <=> $b } keys %svcparams]; } else { die( $self->type . qq[: no value specified for "key$key"] ) unless defined wantarray; @@ -354,12 +354,12 @@ =head2 SvcPriority - $svcpriority = $rr->svcpriority; - $rr->svcpriority( $svcpriority ); + $rr->SvcPriority( $svcpriority ); + $svcpriority = $rr->SvcPriority; -The priority of this record -(relative to others, with lower values preferred). -A value of 0 indicates AliasMode. +The priority of this record relative to others in the RRset, +(lower values being preferred). +A value of 0 indicates AliasMode.') =head2 TargetName @@ -404,7 +404,7 @@ =head1 COPYRIGHT -Copyright (c)2020-2024 Dick Franks. +Copyright (c)2020-2025 Dick Franks. All rights reserved. diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR/TKEY.pm libnet-dns-perl-1.56/lib/Net/DNS/RR/TKEY.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR/TKEY.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR/TKEY.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: TKEY.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: TKEY.pm 2035 2025-08-14 11:49:15Z willem $)[2]; use base qw(Net::DNS::RR); @@ -64,10 +64,6 @@ } -sub class { ## override RR method - return 'ANY'; -} - sub encode { ## override RR method my $self = shift; diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/RR.pm libnet-dns-perl-1.56/lib/Net/DNS/RR.pm --- libnet-dns-perl-1.50/lib/Net/DNS/RR.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/RR.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: RR.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: RR.pm 2037 2025-08-18 14:39:32Z willem $)[2]; =head1 NAME @@ -174,20 +174,24 @@ sub _new_hash { my $base = shift; - my %attribute = ( owner => '.', type => 'NULL' ); + my %argument = ( owner => '.', type => 'NULL' ); + my @attribute; while ( my $key = shift ) { - $attribute{lc $key} = shift; + push @attribute, $key; + $argument{lc $key} = shift; } - my ( $owner, $name, $type, $class, $ttl ) = delete @attribute{@core}; + my ( $owner, $name, $type, $class, $ttl ) = delete @argument{@core}; - my $self = $base->_subclass( $type, scalar(%attribute) ); + my $self = $base->_subclass( $type, scalar(%argument) ); $self->owner( $name ? $name : $owner ); $self->class($class) if defined $class; # optional CLASS $self->ttl($ttl) if defined $ttl; # optional TTL eval { - while ( my ( $attribute, $value ) = each %attribute ) { + foreach my $attribute (@attribute) { + my $value = $argument{lc $attribute}; + next unless defined $value; $self->$attribute( ref($value) eq 'ARRAY' ? @$value : $value ); } }; @@ -322,23 +326,24 @@ sub string { my $self = shift; - my $name = $self->{owner}->string; - my @ttl = grep {defined} $self->{ttl}; - my @core = ( $name, @ttl, $self->class, $self->type ); + my $owner = $self->{owner}->string; + my @ttl = defined $self->{ttl} ? $self->{ttl} : (); + my @class = defined $self->{class} ? $self->class : (); + my @core = ( $owner, @ttl, @class, $self->type ); local $SIG{__DIE__}; my $empty = $self->_empty; my @rdata = $empty ? () : eval { $self->_format_rdata }; carp $@ if $@; - my $tab = length($name) < 72 ? "\t" : ' '; + my $tab = length($owner) < 72 ? "\t" : ' '; my @line = _wrap( join( $tab, @core, '(' ), @rdata, ')' ); my $last = pop(@line); # last or only line $last = join $tab, @core, "@rdata" unless scalar(@line); $self->_annotation('no data') if $empty; - return join "\n\t", @line, _wrap( $last, map {"; $_"} $self->_annotation ); + return join "\n\t", @line, _wrap( $last, $self->_annotation ); } @@ -368,8 +373,9 @@ sub token { my $self = shift; - my @ttl = grep {defined} $self->{ttl}; - my @core = ( $self->{owner}->string, @ttl, $self->class, $self->type ); + my @ttl = defined $self->{ttl} ? $self->{ttl} : (); + my @class = defined $self->{class} ? $self->class : (); + my @core = ( $self->{owner}->string, @ttl, @class, $self->type ); # parse into quoted strings, contiguous non-whitespace and (discarded) comments local $_ = $self->_empty ? '' : join( ' ', $self->_format_rdata ); @@ -395,8 +401,8 @@ sub generic { my $self = shift; - my @ttl = grep {defined} $self->{ttl}; - my @class = map {"CLASS$_"} grep {defined} $self->{class}; + my @ttl = defined $self->{ttl} ? $self->{ttl} : (); + my @class = defined $self->{class} ? "CLASS$self->{class}" : (); my @core = ( $self->{owner}->string, @ttl, @class, "TYPE$self->{type}" ); my $data = $self->rdata; my @data = ( '\\#', length($data), split /(\S{32})/, unpack 'H*', $data ); @@ -715,8 +721,8 @@ sub _annotation { my ( $self, @note ) = @_; - $self->{annotation} = ["@note"] if scalar @note; - return wantarray ? @{$self->{annotation} || []} : (); + push @{$self->{annotation}}, "\t; @note" if scalar @note; + return wantarray ? @{delete( $self->{annotation} ) || []} : undef; } @@ -769,12 +775,10 @@ our $AUTOLOAD; my ($method) = reverse split /::/, $AUTOLOAD; - for ( my $action = $method ) { ## tolerate mixed-case attribute name - tr [A-Z-] [a-z_]; - if ( $self->can($action) ) { - *{$AUTOLOAD} = sub { shift->$action(@_) }; - return &$AUTOLOAD; - } + my $canonical = lc($method); ## tolerate mixed-case attribute name + if ( $self->can($canonical) ) { + *{$AUTOLOAD} = sub { shift->$canonical(@_) }; + return &$AUTOLOAD; } my $oref = ref($self); @@ -786,7 +790,7 @@ my $module = join '::', __PACKAGE__, $self->type; eval("require $module") if $oref eq __PACKAGE__; ## no critic ProhibitStringyEval - @_ = ( <<"END" ); + @_ = (<<"END"); *** FATAL PROGRAM ERROR!! Unknown instance method "$method" *** which the program has attempted to call for the object: *** diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Resolver/Base.pm libnet-dns-perl-1.56/lib/Net/DNS/Resolver/Base.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Resolver/Base.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Resolver/Base.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: Base.pm 2011 2025-02-11 15:18:03Z willem $)[2]; +our $VERSION = (qw$Id: Base.pm 2057 2026-07-16 10:05:04Z willem $)[2]; # @@ -27,7 +27,7 @@ use constant OS_SPEC => "Net::DNS::Resolver::$^O"; use constant OS_UNIX => "Net::DNS::Resolver::UNIX"; -use constant OS_CONF => grep eval "require $_", OS_SPEC, OS_UNIX; ## no critic +use constant OS_CONF => grep( eval "require $_", OS_SPEC ), OS_UNIX; ## no critic use base (OS_CONF)[0]; @@ -42,8 +42,8 @@ # Allow taint tests to be optimised away when appropriate. -use constant TAINT => eval { ${^TAINT} }; -use constant TESTS => TAINT && defined eval { require Scalar::Util; }; +use constant TFLAG => eval { ${^TAINT} }; +use constant TAINT => TFLAG && defined eval { require Scalar::Util; }; use integer; @@ -321,11 +321,9 @@ if ( scalar(@ns) || !defined(wantarray) ) { my @ipv4 = grep { _ipv4($_) } @ip; my @ipv6 = grep { _ipv6($_) } @ip; - my @map4 = map {"::FFFF:$_"} @ipv4; $self->{nameservers} = \@ip; $self->{nameserver4} = \@ipv4; $self->{nameserver6} = \@ipv6; - $self->{mapped_IPv4} = \@map4; } my @IPv4 = @{$self->{nameserver4}}; @@ -517,10 +515,6 @@ $socket->send( $query_data, 0, $sockaddr ); $self->errorstring( $$ns[3] = $! ); - # handle failure to detect taint inside socket->send() - die 'Insecure dependency while running with -T switch' - if TESTS && Scalar::Util::tainted($sockaddr); - my $reply; while ( my @ready = $select->can_read($timeout) ) { my $socket = shift @ready; @@ -616,10 +610,6 @@ $socket->send( $packet_data, 0, $sockaddr ); $self->errorstring($!); - # handle failure to detect taint inside $socket->send() - die 'Insecure dependency while running with -T switch' - if TESTS && Scalar::Util::tainted($sockaddr); - my $expire = time() + $self->{udp_timeout}; ${*$socket}{net_dns_bg} = [$expire, $packet]; return $socket; @@ -846,7 +836,7 @@ return $buffer if length($header) < 2; # uncoverable branch true my $size = unpack 'n', $header; - while ( my $fragment = _read_socket( $socket, $size - length $buffer ) ) { + while ( length( my $fragment = _read_socket( $socket, $size - length $buffer ) ) ) { $buffer .= $fragment; } return $buffer; @@ -872,12 +862,15 @@ $self->_diag('socket disconnected (trying to connect)'); } - my $ip6_addr = IPv6 && _ipv6($ip); + my $port = $self->{port}; + Carp::confess 'Insecure dependency while running with -T switch' + if TAINT && Scalar::Util::tainted("$ip $port"); + $socket = IO::Socket::IP->new( - LocalAddr => $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4}, + LocalAddr => _ipv6($ip) ? $self->{srcaddr6} : $self->{srcaddr4}, LocalPort => $self->{srcport}, PeerAddr => $ip, - PeerPort => $self->{port}, + PeerPort => $port, Proto => 'tcp', Timeout => $self->{tcp_timeout}, GetAddrInfoFlags => AI_NUMERICHOST, @@ -885,17 +878,16 @@ ) if USE_SOCKET_IP; - unless ( USE_SOCKET_IP or $ip6_addr ) { - $socket = IO::Socket::INET->new( - LocalAddr => $self->{srcaddr4}, - LocalPort => $self->{srcport} || undef, - PeerAddr => $ip, - PeerPort => $self->{port}, - Proto => 'tcp', - Timeout => $self->{tcp_timeout}, - @sockopt - ); - } + $socket = IO::Socket::INET->new( + LocalAddr => $self->{srcaddr4}, + LocalPort => $self->{srcport} || undef, + PeerAddr => $ip, + PeerPort => $port, + Proto => 'tcp', + Timeout => $self->{tcp_timeout}, + @sockopt + ) + unless USE_SOCKET_IP; $self->{persistent}{$sock_key} = $socket if $self->{persistent_tcp}; return $socket; @@ -909,9 +901,8 @@ my $sock_key = "UDP[$ip]"; return $socket if $socket = $self->{persistent}{$sock_key}; - my $ip6_addr = IPv6 && _ipv6($ip); $socket = IO::Socket::IP->new( - LocalAddr => $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4}, + LocalAddr => _ipv6($ip) ? $self->{srcaddr6} : $self->{srcaddr4}, LocalPort => $self->{srcport}, Proto => 'udp', Type => SOCK_DGRAM, @@ -920,7 +911,7 @@ ) if USE_SOCKET_IP; - unless ( USE_SOCKET_IP or $ip6_addr ) { + unless ( USE_SOCKET_IP or _ipv6($ip) ) { $socket = IO::Socket::INET->new( LocalAddr => $self->{srcaddr4}, LocalPort => $self->{srcport} || undef, @@ -950,13 +941,16 @@ sub _create_dst_sockaddr { ## create UDP destination sockaddr structure my ( $self, $ip, $port ) = @_; - - unless (USE_SOCKET_IP) { # NB: errors raised in socket->send - return _ipv6($ip) ? undef : sockaddr_in( $port, inet_aton($ip) ); - } - - my @addrinfo = Socket::getaddrinfo( $ip, $port, _ipv6($ip) ? $ip6 : $ip4 ); - return ( grep {ref} @addrinfo, {} )[0]->{addr}; + my $addrinfo; + ($addrinfo) = grep {ref} Socket::getaddrinfo( $ip, $port, _ipv6($ip) ? $ip6 : $ip4 ), {} + if USE_SOCKET_IP; + $addrinfo = _ipv6($ip) ? undef : sockaddr_in( $port, inet_aton($ip) ) + unless USE_SOCKET_IP; + my $sockaddr = USE_SOCKET_IP ? $addrinfo->{addr} : $addrinfo; + + Carp::confess 'Insecure dependency while running with -T switch' + if TAINT && Scalar::Util::tainted($sockaddr); + return $sockaddr; } @@ -992,7 +986,7 @@ my $header = $packet->header; $header->ad( $self->{adflag} ); # RFC6840, 5.7 $header->cd( $self->{cdflag} ); # RFC6840, 5.9 - $header->do(1) if $self->{dnssec}; + $header->do( $self->{dnssec} ); $header->rd( $self->{recurse} ); } diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Resolver/UNIX.pm libnet-dns-perl-1.56/lib/Net/DNS/Resolver/UNIX.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Resolver/UNIX.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Resolver/UNIX.pm 2026-07-17 10:09:44.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: UNIX.pm 2007 2025-02-08 16:45:23Z willem $)[2]; +our $VERSION = (qw$Id: UNIX.pm 2053 2026-07-07 10:18:23Z willem $)[2]; =head1 NAME @@ -18,12 +18,9 @@ my $dotfile = '.resolv.conf'; my @dotfile = grep { -f $_ && -o $_ } map {"$_/$dotfile"} grep {$_} $homedir, '.'; - -my $path = $ENV{PATH}; -local $ENV{PATH} = join ':', grep {$_} qw(/bin /usr/bin), $path; -my $uname = eval {`uname -n 2>/dev/null`} || ''; -chomp $uname; -my ( $host, @domain ) = split /\./, $uname, 2; +my ($name) = _nosh(qw(uname -n)); +chomp $name; +my ( undef, @domain ) = split /\./, $name, 2; sub _init { @@ -40,6 +37,19 @@ return; } +sub _nosh { ## shell-free backtick emulation + my ( $prog, @arg ) = @_; + if ( open( my $pipe, '-|' ) ) { + my @retval = ( <$pipe>, '' ); + close $pipe; + return @retval; + } else { + local $SIG{__WARN__} = sub { }; + warn 'child process fails without warning'; + eval { exec $prog, @arg }; + exit; ## uncoverable statement + } +} 1; __END__ diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Resolver.pm libnet-dns-perl-1.56/lib/Net/DNS/Resolver.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Resolver.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Resolver.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: Resolver.pm 2009 2025-02-10 13:43:50Z willem $)[2]; +our $VERSION = (qw$Id: Resolver.pm 2017 2025-06-27 13:48:03Z willem $)[2]; =head1 NAME @@ -588,8 +588,6 @@ $resolver->tsig( $keyfile, fudge => 60 ); - $resolver->tsig( $tsig_rr ); - $resolver->tsig( undef ); Set the TSIG record used to automatically sign outgoing queries, zone diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Text.pm libnet-dns-perl-1.56/lib/Net/DNS/Text.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Text.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Text.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: Text.pm 2002 2025-01-07 09:57:46Z willem $)[2]; +our $VERSION = (qw$Id: Text.pm 2043 2026-01-14 13:35:59Z willem $)[2]; =head1 NAME @@ -185,7 +185,7 @@ my @s = map { split '', $_ } @$self; # escape special and ASCII non-printable my $s = _decode_utf8( join '', map { $escape{$_} } @s ); - return $s =~ /[ \t\n\r\f(),;]|^$/ ? qq("$s") : $s; # quote special characters and empty string + return $s =~ /[ \t\n\r\f();]|^$/ ? qq("$s") : $s; # quote special characters and empty string } diff -Nru libnet-dns-perl-1.50/lib/Net/DNS/Update.pm libnet-dns-perl-1.56/lib/Net/DNS/Update.pm --- libnet-dns-perl-1.50/lib/Net/DNS/Update.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS/Update.pm 2026-07-17 10:09:44.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: Update.pm 2003 2025-01-21 12:06:06Z willem $)[2]; +our $VERSION = (qw$Id: Update.pm 2017 2025-06-27 13:48:03Z willem $)[2]; =head1 NAME @@ -208,14 +208,6 @@ $update->sign_tsig( $key_file, fudge => 60 ); -=head2 Signing the DNS update using private key generated by BIND dnssec-keygen - - $update->sign_tsig( "$dir/Khmac-sha512.example.com.+165+01018.private" ); - -=head2 Signing the DNS update using public key generated by BIND dnssec-keygen - - $update->sign_tsig( "$dir/Khmac-sha512.example.com.+165+01018.key" ); - =head2 Another way to sign a DNS update use Net::DNS::RR::TSIG; diff -Nru libnet-dns-perl-1.50/lib/Net/DNS.pm libnet-dns-perl-1.56/lib/Net/DNS.pm --- libnet-dns-perl-1.50/lib/Net/DNS.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/lib/Net/DNS.pm 2026-07-17 10:09:44.000000000 +0000 @@ -4,9 +4,9 @@ use warnings; our $VERSION; -$VERSION = '1.50'; +$VERSION = '1.56'; $VERSION = eval {$VERSION}; -our $SVNVERSION = (qw$Id: DNS.pm 2015 2025-02-21 08:37:21Z willem $)[2]; +our $SVNVERSION = (qw$Id: DNS.pm 2058 2026-07-17 10:09:31Z willem $)[2]; =head1 NAME @@ -320,7 +320,7 @@ $update = Net::DNS::Update->new( 'example.com' ); $update->push( prereq => nxrrset('example.com. AAAA') ); - $update->push( update => rr_add('example.com. 86400 AAAA 2001::DB8::F00') ); + $update->push( update => rr_add('example.com. 86400 AAAA 2001:DB8::F00') ); =head2 yxrrset diff -Nru libnet-dns-perl-1.50/t/01-resolver-config.t libnet-dns-perl-1.56/t/01-resolver-config.t --- libnet-dns-perl-1.50/t/01-resolver-config.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/01-resolver-config.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 01-resolver-config.t 2013 2025-02-11 15:52:59Z willem $ -*-perl-*- +# $Id: 01-resolver-config.t 2016 2025-02-27 15:27:42Z willem $ -*-perl-*- # use strict; @@ -52,7 +52,7 @@ my ($IPv6) = $resolver->nameserver(qw(::1)); SKIP: { - skip( 'IPv6 specific test', 6 ) unless $IPv6; + skip( 'IPv6 specific test', 5 ) unless $IPv6; is( $IPv6, '::1', 'IPv6 nameserver' ); my ($pref4) = $class->new( prefer_v4 => 1 )->nameserver(qw(::1 127.0.0.1)); diff -Nru libnet-dns-perl-1.50/t/01-resolver.t libnet-dns-perl-1.56/t/01-resolver.t --- libnet-dns-perl-1.50/t/01-resolver.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/01-resolver.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,10 +1,10 @@ #!/usr/bin/perl -# $Id: 01-resolver.t 1993 2024-11-07 14:06:53Z willem $ -*-perl-*- +# $Id: 01-resolver.t 2046 2026-06-01 13:23:01Z willem $ -*-perl-*- # use strict; use warnings; -use Test::More tests => 38; +use Test::More tests => 39; use TestToolkit; BEGIN { ## off-line dry tests @@ -110,9 +110,13 @@ for my $recursive ( Net::DNS::Resolver::Recurse->new( retrans => 0, retry => 0 ) ) { my $domain = 'net-dns.org'; my $packet = Net::DNS::Packet->new( "$domain", 'NS' ); + + $recursive->_referral($packet); + my $non_referral = $recursive->_recurse( $packet, $domain ); + is( $non_referral, undef, 'non-referral packet' ); + $packet->push( ans => Net::DNS::RR->new("$domain NS nx$$.$domain") ); $packet->push( add => Net::DNS::RR->new("nx$$.$domain AAAA ::") ); - $recursive->_referral($packet); my $result = $recursive->_recurse( $packet, $domain ); diff -Nru libnet-dns-perl-1.50/t/02-domainname.t libnet-dns-perl-1.56/t/02-domainname.t --- libnet-dns-perl-1.50/t/02-domainname.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/02-domainname.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,10 +1,10 @@ #!/usr/bin/perl -# $Id: 02-domainname.t 1910 2023-03-30 19:16:30Z willem $ -*-perl-*- +# $Id: 02-domainname.t 2054 2026-07-10 09:37:11Z willem $ -*-perl-*- # use strict; use warnings; -use Test::More tests => 35; +use Test::More tests => 36; use TestToolkit; @@ -122,6 +122,9 @@ my $loop = pack 'H*', '0344454603414243c000'; exception( 'compression loop', sub { Net::DNS::DomainName->decode( \$loop, 4 ) } ); +my $deep = pack 'H*', '017800c000c003c005c007'; +exception( 'long compression chain', sub { Net::DNS::DomainName->decode( \$deep, 9, {}, 118 ) } ); + exit; diff -Nru libnet-dns-perl-1.50/t/03-parameters.t libnet-dns-perl-1.56/t/03-parameters.t --- libnet-dns-perl-1.50/t/03-parameters.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/03-parameters.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 03-parameters.t 1921 2023-05-08 18:39:59Z willem $ -*-perl-*- +# $Id: 03-parameters.t 2042 2025-12-24 10:23:11Z willem $ -*-perl-*- # use strict; @@ -26,8 +26,8 @@ foreach ( sort { $a <=> $b } 65535, keys %Net::DNS::Parameters::typebyval ) { my $name = typebyval($_); ## check type conversion functions - my $code = eval { typebyname($name) }; - is( $code, $_, "typebyname($name)" ); + my $code = eval { typebyname($name) }; ## NB: codes may be aliased + is( typebyval($code), $name, "typebyname($name)" ); } is( typebyname('*'), typebyname('ANY'), "typebyname(*)" ); diff -Nru libnet-dns-perl-1.50/t/03-rr.t libnet-dns-perl-1.56/t/03-rr.t --- libnet-dns-perl-1.50/t/03-rr.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/03-rr.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,10 +1,10 @@ #!/usr/bin/perl -# $Id: 03-rr.t 1910 2023-03-30 19:16:30Z willem $ -*-perl-*- +# $Id: 03-rr.t 2035 2025-08-14 11:49:15Z willem $ -*-perl-*- # use strict; use warnings; -use Test::More tests => 106; +use Test::More tests => 98; use TestToolkit; @@ -40,7 +40,7 @@ for my $example ( Net::DNS::RR->new('example.com. 0 IN A 192.0.2.1') ) { - my $expect = $example->string; ## check basic parsing of all acceptable forms of A record + my $expect = unpack 'H*', $example->encode; ## check basic parsing of all acceptable forms of A record foreach my $testcase ( join( "\t", qw( example.com 0 IN A ), q(\# 4 c0 00 02 01) ), join( "\t", qw( example.com 0 IN A ), q(\# 4 c0000201 ) ), @@ -61,15 +61,14 @@ 'example.com CLASS1 0 A 192.0.2.1', 'example.com CLASS1 0 TYPE1 192.0.2.1', ) { - my $rr = Net::DNS::RR->new("$testcase"); - $rr->ttl( $example->ttl ); # TTL only shown if defined - is( $rr->string, $expect, "Net::DNS::RR->new( $testcase )" ); + my $result = unpack 'H*', Net::DNS::RR->new("$testcase")->encode; + is( $result, $expect, "Net::DNS::RR->new( $testcase )" ); } } for my $example ( Net::DNS::RR->new('example.com. 0 IN TXT "txt-data"') ) { - my $expect = $example->string; ## check parsing of comments, quotes and brackets + my $expect = unpack 'H*', $example->encode; ## check parsing of comments, quotes and brackets foreach my $testcase ( q(example.com 0 IN TXT txt-data ; space delimited), q(example.com 0 TXT txt-data), @@ -88,9 +87,8 @@ q(example.com IN 0 TXT "txt-data"), 'example.com ( 0 IN TXT txt-data ) ; bracketed', ) { - my $rr = Net::DNS::RR->new("$testcase"); - $rr->ttl( $example->ttl ); # TTL only shown if defined - is( $rr->string, $expect, "Net::DNS::RR->new( $testcase )" ); + my $result = unpack 'H*', Net::DNS::RR->new("$testcase")->encode; + is( $result, $expect, "Net::DNS::RR->new( $testcase )" ); } } @@ -114,22 +112,23 @@ } -foreach my $testcase ( ## check encode/decode functions - 'example.com A', - 'example.com IN', - 'example.com IN A', - 'example.com IN 123 A', - 'example.com 123 A', - 'example.com 123 IN A', - 'example.com A 192.0.2.1', - '1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.B.D.0.1.0.0.2.ip6.arpa PTR example.com.' - ) { - my $rr = Net::DNS::RR->new("$testcase"); - my $encoded = $rr->encode; - my $decoded = Net::DNS::RR->decode( \$encoded ); - $rr->ttl( $decoded->ttl ) unless $rr->ttl; - is( $decoded->string, $rr->string, "encode/decode $testcase" ); -} +#foreach my $testcase ( ## check encode/decode functions +# 'example.com A', +# 'example.com IN', +# 'example.com IN A', +# 'example.com IN 123 A', +# 'example.com 123 A', +# 'example.com 123 IN A', +# 'example.com A 192.0.2.1', +# '1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.B.D.0.1.0.0.2.ip6.arpa PTR example.com.' +# ) { +# my $rr = Net::DNS::RR->new("$testcase"); +# my $encoded = $rr->encode; +# my $decoded = Net::DNS::RR->decode( \$encoded ); +# $rr->ttl( $decoded->{ttl} ) unless defined $rr->{ttl}; +# $rr->class( $decoded->{class} ) unless defined $rr->{class}; +# is( $decoded->string, $rr->string, "encode/decode $testcase" ); +#} for my $rr ( Net::DNS::RR->new( type => 'OPT' ) ) { @@ -153,8 +152,8 @@ foreach my $testcase ( ## check plain and generic formats [owner => 'example.com.', type => 'A'], [owner => 'example.com.', type => 'A', rdata => ''], - ['example.com. IN NS a.iana-servers.net.'], - [ 'example.com. IN SOA ( + ['example.com. 86400 NS a.iana-servers.net.'], + ['example.com. IN SOA ( sns.dns.icann.org. noc.dns.icann.org. 2015082417 ;serial 7200 ;refresh diff -Nru libnet-dns-perl-1.50/t/04-packet.t libnet-dns-perl-1.56/t/04-packet.t --- libnet-dns-perl-1.50/t/04-packet.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/04-packet.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 04-packet.t 1980 2024-06-02 10:16:33Z willem $ -*-perl-*- +# $Id: 04-packet.t 2035 2025-08-14 11:49:15Z willem $ -*-perl-*- # use strict; @@ -81,6 +81,8 @@ my $i = ++$index; my $rr1 = Net::DNS::RR->new( Name => "$section$i.example.test", + Class => "IN", + TTL => 3600, Type => "A", Address => "10.0.0.$i" ); @@ -92,6 +94,8 @@ my $j = ++$index; my $rr2 = Net::DNS::RR->new( Name => "$section$j.example.test", + Class => "IN", + TTL => 3600, Type => "A", Address => "10.0.0.$j" ); @@ -102,11 +106,12 @@ } # Add enough distinct labels to render compression unusable at some point +my $longtext = 'x' x 255; for ( 0 .. 255 ) { - $update->push( 'answer', Net::DNS::RR->new( "X$_ TXT \"" . pack( "A255", "x" ) . '"' ) ); + $update->push( 'answer', Net::DNS::RR->new("X$_ 0 IN TXT $longtext") ); } -$update->push( 'answer', Net::DNS::RR->new('XY TXT ""') ); -$update->push( 'answer', Net::DNS::RR->new('VW.XY TXT ""') ); +$update->push( 'answer', Net::DNS::RR->new('XY 0 IN TXT ""') ); +$update->push( 'answer', Net::DNS::RR->new('VW.XY 0 IN TXT ""') ); # Decode data buffer and compare with original my $buffer = $update->encode; @@ -124,17 +129,11 @@ ok( $decoded->answerfrom, 'answerfrom() alias works' ); -foreach my $section (qw(question)) { +foreach my $section (qw(question answer authority additional)) { my @original = map { $_->string } $update->$section; my @content = map { $_->string } $decoded->$section; is_deeply( \@content, \@original, "check content of $section section" ); } - -foreach my $section (qw(answer authority additional)) { - my @original = map { $_->ttl(0); $_->string } $update->$section; # almost! need TTL defined - my @content = map { $_->string } $decoded->$section; - is_deeply( \@content, \@original, "check content of $section section" ); -} # check that pop() removes RR from section Memo to self: no RR in question section! diff -Nru libnet-dns-perl-1.50/t/05-DELEG.t libnet-dns-perl-1.56/t/05-DELEG.t --- libnet-dns-perl-1.50/t/05-DELEG.t 1970-01-01 00:00:00.000000000 +0000 +++ libnet-dns-perl-1.56/t/05-DELEG.t 2026-07-17 10:09:44.000000000 +0000 @@ -0,0 +1,100 @@ +#!/usr/bin/perl +# $Id: 05-DELEG.t 2046 2026-06-01 13:23:01Z willem $ -*-perl-*- +# + +use strict; +use warnings; +use Net::DNS; + +use Test::More; +use TestToolkit; + +exit( plan skip_all => 'unresolved AUTOLOAD regression [perl #120694]' ) + unless ( $] > 5.018001 ) + or ( $] < 5.018 ); + +plan tests => 47; + + +my $type = 'DELEG'; + +my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode; +ok( $typecode, "$type RR type code = $typecode" ); + + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type" ) ) { + ok( $rr, "parse RR: $record" ); + is( $rr->rdata, '', 'empty rdata' ); + is( $rr->mandatory, undef, 'mandatory undefined' ); + is( $rr->server_ipv4, undef, 'server_ipv4 undefined' ); + is( $rr->server_ipv6, undef, 'server_ipv6 undefined' ); + is( $rr->server_name, undef, 'server_name undefined' ); + is( $rr->include_delegparam, undef, 'include_delegparam undefined' ); + ok( $rr->string, 'presentation format string' ); + ok( $rr->generic, 'RFC3597 generic format' ); +} + + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type server-ipv4=192.0.2.1,192.0.2.2" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key1(), 'correct parameter key defined' ); + my @list = eval { $rr->server_ipv4 }; + is( scalar(@list), 2, '$rr->server_ipv4 returns address list' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type server-ipv6=2001:db8::1,2001:db8::2" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key2(), 'correct parameter key defined' ); + my @list = eval { $rr->server_ipv6 }; + is( scalar(@list), 2, '$rr->server_ipv6 returns address list' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type server-name=nameserver.example" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key3(), 'correct parameter key defined' ); + is( $rr->server_name, 'nameserver.example.', '$rr->server_name returns domain name' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = qq(example. $type include-delegparam="provider.example") ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key4(), 'correct parameter key defined' ); + is( $rr->include_delegparam, 'provider.example.', '$rr->include_delegparam returns domain name' ); +} + + +for my $rr ( Net::DNS::RR->new( my $record = "example. 0 IN $type" ) ) { + ok( $rr, "parse RR: $record" ); + is( $rr->rdata, '', 'empty rdata' ); + ok( $rr->mandatory( 1, 2, 3 ), 'mandatory write access method' ); + ok( $rr->server_ipv4('192.0.2.1'), 'server_ipv4 write access method' ); + ok( $rr->server_ipv6('2001:db8::53'), 'server_ipv6 write access method' ); + ok( $rr->server_name('nameserver.example.'), 'server_name write access method' ); + ok( $rr->include_delegparam('provider.example.'), 'include_delegparam write access method' ); + ok( $rr->rdata, 'non-empty rdata' ); + ok( $rr->encode, 'wire-format octet string' ); + ok( !$rr->key65500(undef), 'delete parameter' ); + ok( $rr->_parameter( 65500, '!' ), 'unexpected parameter' ); + ok( $rr->string, 'presentation format string' ); + ok( $rr->generic, 'RFC3597 generic format' ); + my $encoded = $rr->encode; + my $decoded = ref($rr)->decode( \$encoded ); + is( $decoded->generic, $rr->generic, 'encode/decode transparent' ); + my $rdata = pack 'n2a*', 65500, 5, 'xxxx'; + local $rr->{rdlength} = length $rdata; + exception( 'rdata corruption', sub { $rr->_decode_rdata( \$rdata, 0 ) } ); +} + + +exception( 'duplicated parameter', sub { Net::DNS::RR->new("example. $type server-name=x server-name=y") } ); +exception( 'incompatible parameter', sub { Net::DNS::RR->new("example. $type include-delegparam=x server-name=y") } ); +exception( 'invalid argument', sub { Net::DNS::RR->new("example. $type include-delegparam=.") } ); +exception( 'invalid argument', sub { Net::DNS::RR->new("example. $type server-name=.") } ); +exception( 'unexpected argument', sub { Net::DNS::RR->new("example. $type")->key65500(qw(X Y)) } ); +exception( 'unrecognised parameter', sub { Net::DNS::RR->new("example. $type bogus") } ); +exception( 'mandatory key0 in list', sub { Net::DNS::RR->new("example. $type mandatory=server-ipv4,key0") } ); +exception( 'mandatory key repeated', sub { Net::DNS::RR->new("example. $type mandatory=key1,key1") } ); +exception( 'mandatory key required', sub { Net::DNS::RR->new("example. $type mandatory=key1,key2 key1=X") } ); +exception( 'mandatory key unknown', sub { Net::DNS::RR->new("example. $type mandatory=bogus") } ); + +exit; + diff -Nru libnet-dns-perl-1.50/t/05-DNSKEY.t libnet-dns-perl-1.56/t/05-DNSKEY.t --- libnet-dns-perl-1.50/t/05-DNSKEY.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/05-DNSKEY.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 05-DNSKEY.t 1910 2023-03-30 19:16:30Z willem $ -*-perl-*- +# $Id: 05-DNSKEY.t 2042 2025-12-24 10:23:11Z willem $ -*-perl-*- # use strict; @@ -19,7 +19,7 @@ exit; } -plan tests => 49; +plan tests => 53; my $name = 'DNSKEY.example'; @@ -87,6 +87,7 @@ toggle( $rr, 'zone', 1, 0, 1, 0 ); toggle( $rr, 'revoke', 0, 1, 0, 1 ); + toggle( $rr, 'adt', 1, 0, 1, 0 ); toggle( $rr, 'sep', 1, 0, 1, 0 ); my $class = ref($rr); diff -Nru libnet-dns-perl-1.50/t/05-NULL.t libnet-dns-perl-1.56/t/05-NULL.t --- libnet-dns-perl-1.50/t/05-NULL.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/05-NULL.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 05-NULL.t 1910 2023-03-30 19:16:30Z willem $ -*-perl-*- +# $Id: 05-NULL.t 2035 2025-08-14 11:49:15Z willem $ -*-perl-*- # use strict; @@ -40,6 +40,7 @@ is( $rr2->$_, $rr->$_, "additional attribute rr->$_()" ); } + $rr->class(1); $rr->ttl(1234); my $encoded = $rr->encode; my $decoded = Net::DNS::RR->decode( \$encoded ); diff -Nru libnet-dns-perl-1.50/t/05-SVCB.t libnet-dns-perl-1.56/t/05-SVCB.t --- libnet-dns-perl-1.50/t/05-SVCB.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/05-SVCB.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 05-SVCB.t 1996 2024-12-16 13:05:08Z willem $ -*-perl-*- +# $Id: 05-SVCB.t 2043 2026-01-14 13:35:59Z willem $ -*-perl-*- # use strict; @@ -14,71 +14,97 @@ unless ( $] > 5.018001 ) or ( $] < 5.018 ); -plan tests => 48; +plan tests => 78; - -my $name = 'SVCB.example'; my $type = 'SVCB'; -my $code = 64; -my @attr = qw( svcpriority targetname port ); -my @data = qw( 1 pool.svc.example 1234 ); -my @also = qw(mandatory alpn no-default-alpn port ipv4hint ech ipv6hint dohpath ohttp); -my $wire = '000104706f6f6c03737663076578616d706c65000003000204d2'; +my @keys = qw(mandatory alpn no-default-alpn port ipv4hint ech ipv6hint); +my @also = qw(dohpath ohttp tls-supported-groups); my $typecode = unpack 'xn', Net::DNS::RR->new( type => $type )->encode; -is( $typecode, $code, "$type RR type code = $code" ); +ok( $typecode, "$type RR type code = $typecode" ); -my $hash = {}; -@{$hash}{@attr} = @data; +for my $rr ( Net::DNS::RR->new( my $record = "example. $type" ) ) { + ok( $rr, "parse RR: $record" ); + foreach my $parameter ( qw(SvcPriority TargetName), @keys, @also ) { + is( $rr->$parameter, undef, "$parameter undefined" ); + } + is( $rr->rdata, '', 'empty rdata' ); + ok( $rr->string, 'presentation format string' ); +} -for my $rr ( Net::DNS::RR->new( name => $name, type => $type, %$hash ) ) { - my $string = $rr->string; - my $rr2 = Net::DNS::RR->new($string); - is( $rr2->string, $string, 'new/string transparent' ); +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 0 target.example." ) ) { + ok( $rr, "parse RR: $record" ); + ok( $rr->TargetName, 'TargetName defined' ); + is( $rr->SvcPriority, 0, 'SvcPriority zero' ); + ok( $rr->string, 'presentation format string' ); +} - is( $rr2->encode, $rr->encode, 'new($string) and new(%hash) equivalent' ); - foreach (qw(svcpriority targetname)) { - is( $rr->$_, $hash->{$_}, "expected result from rr->$_()" ); - } +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 target.example." ) ) { + ok( $rr, "parse RR: $record" ); + ok( $rr->TargetName, 'TargetName defined' ); + is( $rr->SvcPriority, 1, 'SvcPriority non-zero' ); + ok( $rr->string, 'presentation format string' ); +} - my $encoded = $rr->encode; - my $decoded = Net::DNS::RR->decode( \$encoded ); - my $hex1 = unpack 'H*', $encoded; - my $hex2 = unpack 'H*', $decoded->encode; - my $hex3 = unpack 'H*', $rr->rdata; - is( $hex2, $hex1, 'encode/decode transparent' ); - is( $hex3, $wire, 'encoded RDATA matches example' ); +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 ." ) ) { + ok( $rr, "parse RR: $record" ); + is( $rr->TargetName, $rr->owner, 'TargetName defined' ); + ok( $rr->string, 'presentation format string' ); } -for my $rr ( Net::DNS::RR->new(". $type") ) { - foreach ( qw(TargetName), @also ) { - is( $rr->$_(), undef, "empty RR has undefined $_" ); - } +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . mandatory=alpn alpn=h2,h3" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key0(), 'correct SvcParameter key defined' ); +} - $rr->svcpriority(1); - $rr->targetname('.'); - my $l0 = length $rr->encode; - $rr->no_default_alpn(0); - $rr->no_default_alpn(1); - isnt( length( $rr->encode ), $l0, 'insert SvcParams key' ); - $rr->no_default_alpn(undef); - is( length( $rr->encode ), $l0, 'delete SvcParams key' ); +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . alpn=h2,h3 no-default-alpn" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key1(), 'correct SvcParameter key defined' ); + ok( defined $rr->no_default_alpn, '$rr->no_default_alpn true' ); } +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . port=53" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key3(), 'correct SvcParameter key defined' ); +} -for my $corruption ( pack 'H*', '00004000010000000000070001000bad0001' ) { - local $SIG{__WARN__} = sub { }; - my $rr = Net::DNS::RR->decode( \$corruption ); - like( $rr->string, '/corrupt/i', 'string() includes corrupt RDATA' ); +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . ipv4hint=192.0.2.1" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key4(), 'correct SvcParameter key defined' ); } +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . ech=Base64format" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key5(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . ipv6hint=192.0.2.1" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key6(), 'correct SvcParameter key defined' ); +} -Net::DNS::RR->new( <<'END' )->print; -example.com. SVCB 16 foo.example.org. ( mandatory=alpn alpn=h2,h3-19 +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . dohpath=/dns-query{?dns}" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key7(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . ohttp=0 ohttp=1" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key8(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = "example. $type 1 . tls-supported-groups=29,23" ) ) { + ok( $rr, "parse RR: $record" ); + ok( defined $rr->key9(), 'correct SvcParameter key defined' ); +} + + +Net::DNS::RR->new(<<"END")->print; +example.com. $type 16 foo.example.org. ( mandatory=alpn alpn=h2,h3-19 no-default-alpn port=1234 ipv4hint=192.0.2.1 ech=AEP+DQA/BAAgACCW2/dfOBZAtQU55/py/BlhdRdaauPAkrERAUwppoeSEgAEAAEAAQAQY2QxLnRlc3QuZGVmby5pZQAA ipv6hint=2001:db8::1 @@ -89,6 +115,22 @@ END +for my $rr ( Net::DNS::RR->new("example. $type 1 . ") ) { + my $l0 = length $rr->encode; + $rr->port(53); + is( length( $rr->encode ), $l0 + 6, 'insert SvcParams key' ); +} + + +for my $corruption ( pack 'H*', '00004000010000000000070001000bad0001' ) { + local $SIG{__WARN__} = sub { }; + my $rr = Net::DNS::RR->decode( \$corruption ); + like( $rr->string, '/corrupt/i', 'string() includes corrupt RDATA' ); + is( length( $rr->encode ), length($corruption), 'preserve corrupt rdata' ); + exception( 'non-existent method', sub { $rr->bogus } ); +} + + #### Test Vectors my $zonefile = Net::DNS::ZoneFile->new( \*DATA ); diff -Nru libnet-dns-perl-1.50/t/08-IPv4.t libnet-dns-perl-1.56/t/08-IPv4.t --- libnet-dns-perl-1.50/t/08-IPv4.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/08-IPv4.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 08-IPv4.t 2007 2025-02-08 16:45:23Z willem $ -*-perl-*- +# $Id: 08-IPv4.t 2046 2026-06-01 13:23:01Z willem $ -*-perl-*- # use strict; @@ -53,7 +53,7 @@ exit plan skip_all => "Non-authoritative response from $from" unless $reply->header->aa; 1; -} || exit( plan skip_all => "Cannot reach global root: $@" ); +} || exit( plan skip_all => $@ || 'Cannot reach global root' ); my $IP = eval { @@ -69,7 +69,7 @@ Net::DNS::Resolver->debug($debug); -plan tests => 62; +plan tests => 61; NonFatalBegin(); @@ -91,21 +91,6 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); - $resolver->udppacketsize(513); - - $resolver->igntc(1); - my $udp = $resolver->send(qw(net-dns.org DNSKEY IN)); - ok( $udp && $udp->header->tc, '$resolver->send(...) truncated UDP reply' ); - - $resolver->igntc(0); - my $retry = $resolver->send(qw(net-dns.org DNSKEY IN)); - ok( $retry && !$retry->header->tc, '$resolver->send(...) automatic TCP retry' ); -} - - -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(0); my $packet = Net::DNS::Packet->new(qw(net-dns.org SOA IN)); @@ -126,12 +111,25 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); $resolver->udppacketsize(513); + $resolver->igntc(1); + my $udp = $resolver->send(qw(doc.net-dns.org TXT IN)); + ok( $udp && $udp->header->tc, '$resolver->send(...) expecting truncated UDP reply' ); - my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); - ok( $handle, '$resolver->bgsend(...) truncated UDP' ); + $resolver->igntc(0); + my $retry = $resolver->send(qw(doc.net-dns.org TXT IN)); + ok( $retry && !$retry->header->tc, '$resolver->send(...) automatic TCP retry' ); +} + + +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); + $resolver->udppacketsize(513); + $resolver->igntc(1); + + my $handle = $resolver->bgsend(qw(doc.net-dns.org TXT IN)); + ok( $handle, '$resolver->bgsend(...) expecting truncated UDP reply' ); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) ignore UDP truncation' ); } @@ -139,12 +137,11 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); - my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); - ok( $handle, '$resolver->bgsend(...) truncated UDP' ); + my $handle = $resolver->bgsend(qw(doc.net-dns.org TXT IN)); + ok( $handle, '$resolver->bgsend(...) expecting truncated UDP reply' ); my $udp = $handle; my $packet = $resolver->bgread($handle); isnt( $handle, $udp, '$resolver->bgbusy($udp) handle changed to TCP' ); @@ -154,11 +151,10 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); - my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); + my $handle = $resolver->bgsend(qw(doc.net-dns.org TXT IN)); $resolver->nameserver(); # no nameservers my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) background TCP fail' ); @@ -366,13 +362,6 @@ } -{ - my $resolver = Net::DNS::Resolver->new(); - $resolver->nameserver('cname.t.net-dns.org'); - ok( scalar( $resolver->nameservers ), 'resolve nameserver cname' ); -} - - { ## exercise error paths in _axfr_next() my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->tcp_timeout(10); diff -Nru libnet-dns-perl-1.50/t/08-IPv6.t libnet-dns-perl-1.56/t/08-IPv6.t --- libnet-dns-perl-1.50/t/08-IPv6.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/08-IPv6.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 08-IPv6.t 2007 2025-02-08 16:45:23Z willem $ -*-perl-*- +# $Id: 08-IPv6.t 2046 2026-06-01 13:23:01Z willem $ -*-perl-*- # use strict; @@ -56,7 +56,7 @@ exit plan skip_all => "Non-authoritative response from $from" unless $reply->header->aa; 1; -} || exit( plan skip_all => "Cannot reach global root: $@" ); +} || exit( plan skip_all => $@ || 'Cannot reach global root' ); my $IP = eval { @@ -72,7 +72,7 @@ Net::DNS::Resolver->debug($debug); -plan tests => 62; +plan tests => 61; NonFatalBegin(); @@ -94,21 +94,6 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); - $resolver->udppacketsize(513); - - $resolver->igntc(1); - my $udp = $resolver->send(qw(net-dns.org DNSKEY IN)); - ok( $udp && $udp->header->tc, '$resolver->send(...) truncated UDP reply' ); - - $resolver->igntc(0); - my $retry = $resolver->send(qw(net-dns.org DNSKEY IN)); - ok( $retry && !$retry->header->tc, '$resolver->send(...) automatic TCP retry' ); -} - - -{ - my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->igntc(0); my $packet = Net::DNS::Packet->new(qw(net-dns.org SOA IN)); @@ -129,12 +114,25 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); $resolver->udppacketsize(513); + $resolver->igntc(1); + my $udp = $resolver->send(qw(doc.net-dns.org TXT IN)); + ok( $udp && $udp->header->tc, '$resolver->send(...) expecting truncated UDP reply' ); - my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); - ok( $handle, '$resolver->bgsend(...) truncated UDP' ); + $resolver->igntc(0); + my $retry = $resolver->send(qw(doc.net-dns.org TXT IN)); + ok( $retry && !$retry->header->tc, '$resolver->send(...) automatic TCP retry' ); +} + + +{ + my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); + $resolver->udppacketsize(513); + $resolver->igntc(1); + + my $handle = $resolver->bgsend(qw(doc.net-dns.org TXT IN)); + ok( $handle, '$resolver->bgsend(...) expecting truncated UDP reply' ); my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) ignore UDP truncation' ); } @@ -142,12 +140,11 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); - my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); - ok( $handle, '$resolver->bgsend(...) truncated UDP' ); + my $handle = $resolver->bgsend(qw(doc.net-dns.org TXT IN)); + ok( $handle, '$resolver->bgsend(...) expecting truncated UDP reply' ); my $udp = $handle; my $packet = $resolver->bgread($handle); isnt( $handle, $udp, '$resolver->bgbusy($udp) handle changed to TCP' ); @@ -157,11 +154,10 @@ { my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); - $resolver->dnssec(1); $resolver->udppacketsize(513); $resolver->igntc(0); - my $handle = $resolver->bgsend(qw(net-dns.org DNSKEY IN)); + my $handle = $resolver->bgsend(qw(doc.net-dns.org TXT IN)); $resolver->nameserver(); # no nameservers my $packet = $resolver->bgread($handle); ok( $packet && $packet->header->tc, '$resolver->bgread($udp) background TCP fail' ); @@ -369,13 +365,6 @@ } -{ - my $resolver = Net::DNS::Resolver->new(); - $resolver->nameserver('cname.t.net-dns.org'); - ok( scalar( $resolver->nameservers ), 'resolve nameserver cname' ); -} - - { ## exercise error paths in _axfr_next() my $resolver = Net::DNS::Resolver->new( nameservers => $IP ); $resolver->tcp_timeout(10); diff -Nru libnet-dns-perl-1.50/t/08-recurse.t libnet-dns-perl-1.56/t/08-recurse.t --- libnet-dns-perl-1.50/t/08-recurse.t 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/08-recurse.t 2026-07-17 10:09:44.000000000 +0000 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 08-recurse.t 2007 2025-02-08 16:45:23Z willem $ -*-perl-*- +# $Id: 08-recurse.t 2017 2025-06-27 13:48:03Z willem $ -*-perl-*- # use strict; @@ -43,7 +43,7 @@ exit plan skip_all => "Non-authoritative response from $from" unless $reply->header->aa; 1; -} || exit( plan skip_all => "Cannot reach global root: $@" ); +} || exit( plan skip_all => $@ || 'Cannot reach global root' ); plan tests => 12; diff -Nru libnet-dns-perl-1.50/t/TestToolkit.pm libnet-dns-perl-1.56/t/TestToolkit.pm --- libnet-dns-perl-1.50/t/TestToolkit.pm 2025-02-21 08:37:33.000000000 +0000 +++ libnet-dns-perl-1.56/t/TestToolkit.pm 2026-07-17 10:09:44.000000000 +0000 @@ -1,4 +1,4 @@ -# $Id: TestToolkit.pm 1908 2023-03-15 07:28:50Z willem $ -*-perl-*- +# $Id: TestToolkit.pm 2017 2025-06-27 13:48:03Z willem $ -*-perl-*- package TestToolkit; @@ -54,7 +54,7 @@ local ( $@, $!, $SIG{__DIE__} ); ## isolate eval eval { &$code; - croak shift(@warning) if @warning; + die "$_\n" for @warning; }; my ($exception) = split /[\r\n]+/, "$@\n"; return $exception;