Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-Net-DNS for openSUSE:Factory checked in at 2025-10-10 17:07:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Net-DNS (Old) and /work/SRC/openSUSE:Factory/.perl-Net-DNS.new.5300 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Net-DNS" Fri Oct 10 17:07:56 2025 rev:82 rq:1310018 version:1.530.0 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Net-DNS/perl-Net-DNS.changes 2025-08-27 21:33:18.967263040 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Net-DNS.new.5300/perl-Net-DNS.changes 2025-10-10 17:08:21.126722656 +0200 @@ -1,0 +2,6 @@ +Tue Oct 7 13:34:06 UTC 2025 - Tina Müller <[email protected]> + +- updated to 1.530.0 (1.53) + see /usr/share/doc/packages/perl-Net-DNS/Changes + +------------------------------------------------------------------- Old: ---- Net-DNS-1.52.tar.gz New: ---- Net-DNS-1.53.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Net-DNS.spec ++++++ --- /var/tmp/diff_new_pack.Hcslgj/_old 2025-10-10 17:08:22.254770227 +0200 +++ /var/tmp/diff_new_pack.Hcslgj/_new 2025-10-10 17:08:22.258770396 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-Net-DNS # -# Copyright (c) 2025 SUSE LLC +# Copyright (c) 2025 SUSE LLC and contributors # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,10 +18,10 @@ %define cpan_name Net-DNS Name: perl-Net-DNS -Version: 1.520.0 +Version: 1.530.0 Release: 0 -# 1.52 -> normalize -> 1.520.0 -%define cpan_version 1.52 +# 1.53 -> normalize -> 1.530.0 +%define cpan_version 1.53 License: MIT Summary: Perl Interface to the Domain Name System URL: https://metacpan.org/release/%{cpan_name} @@ -85,7 +85,7 @@ Provides: perl(Net::DNS::Packet) = 2003.0.0 Provides: perl(Net::DNS::Parameters) = 2021.0.0 Provides: perl(Net::DNS::Question) = 2002.0.0 -Provides: perl(Net::DNS::RR) = 2028.0.0 +Provides: perl(Net::DNS::RR) = 2037.0.0 Provides: perl(Net::DNS::RR::A) = 2003.0.0 Provides: perl(Net::DNS::RR::AAAA) = 2003.0.0 Provides: perl(Net::DNS::RR::AFSDB) = 2002.0.0 @@ -98,7 +98,7 @@ Provides: perl(Net::DNS::RR::CERT) = 2002.0.0 Provides: perl(Net::DNS::RR::CNAME) = 2003.0.0 Provides: perl(Net::DNS::RR::CSYNC) = 2003.0.0 -Provides: perl(Net::DNS::RR::DELEG) = 2033.0.0 +Provides: perl(Net::DNS::RR::DELEG) = 2039.0.0 Provides: perl(Net::DNS::RR::DHCID) = 2003.0.0 Provides: perl(Net::DNS::RR::DNAME) = 2003.0.0 Provides: perl(Net::DNS::RR::DNSKEY) = 2003.0.0 @@ -158,8 +158,8 @@ Provides: perl(Net::DNS::RR::SPF) = 2003.0.0 Provides: perl(Net::DNS::RR::SRV) = 2003.0.0 Provides: perl(Net::DNS::RR::SSHFP) = 2003.0.0 -Provides: perl(Net::DNS::RR::SVCB) = 2033.0.0 -Provides: perl(Net::DNS::RR::TKEY) = 2003.0.0 +Provides: perl(Net::DNS::RR::SVCB) = 2037.0.0 +Provides: perl(Net::DNS::RR::TKEY) = 2035.0.0 Provides: perl(Net::DNS::RR::TLSA) = 2003.0.0 Provides: perl(Net::DNS::RR::TSIG) = 2003.0.0 Provides: perl(Net::DNS::RR::TXT) = 2003.0.0 ++++++ Net-DNS-1.52.tar.gz -> Net-DNS-1.53.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/Changes new/Net-DNS-1.53/Changes --- old/Net-DNS-1.52/Changes 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/Changes 2025-08-29 14:17:53.000000000 +0200 @@ -1,4 +1,10 @@ -$Id: Changes 2034 2025-07-29 18:04:34Z willem $ -*-text-*- +$Id: Changes 2041 2025-08-29 12:11:41Z willem $ -*-text-*- + + +**** 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/META.json new/Net-DNS-1.53/META.json --- old/Net-DNS-1.52/META.json 2025-07-29 20:05:02.000000000 +0200 +++ new/Net-DNS-1.53/META.json 2025-08-29 14:17:59.000000000 +0200 @@ -79,6 +79,6 @@ } }, "release_status" : "stable", - "version" : "1.52", + "version" : "1.53", "x_serialization_backend" : "JSON::PP version 4.16" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/META.yml new/Net-DNS-1.53/META.yml --- old/Net-DNS-1.52/META.yml 2025-07-29 20:05:02.000000000 +0200 +++ new/Net-DNS-1.53/META.yml 2025-08-29 14:17:59.000000000 +0200 @@ -55,5 +55,5 @@ perl: '5.008009' strict: '1.03' warnings: '1.0501' -version: '1.52' +version: '1.53' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/lib/Net/DNS/RR/DELEG.pm new/Net-DNS-1.53/lib/Net/DNS/RR/DELEG.pm --- old/Net-DNS-1.52/lib/Net/DNS/RR/DELEG.pm 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/lib/Net/DNS/RR/DELEG.pm 2025-08-29 14:17:53.000000000 +0200 @@ -2,9 +2,9 @@ use strict; use warnings; -our $VERSION = (qw$Id: DELEG.pm 2033 2025-07-29 18:03:07Z willem $)[2]; +our $VERSION = (qw$Id: DELEG.pm 2039 2025-08-26 09:01:09Z willem $)[2]; -use base qw(Net::DNS::RR::SVCB); +use base qw(Net::DNS::RR); =head1 NAME @@ -15,38 +15,67 @@ use integer; -my %keyname = reverse( - alpn => 'key1', # RFC9460(7.1) - 'no-default-alpn' => 'key2', # RFC9460(7.1) - port => 'key3', # RFC9460(7.2) - IPv4 => 'key4', - IPv6 => 'key6', - dohpath => 'key7', # RFC9461 - 'tls-supported-groups' => 'key9', +use Net::DNS::RR::A; +use Net::DNS::RR::AAAA; +use Net::DNS::DomainName; + +my %keyname = ( + 1 => 'server-ip4', + 2 => 'server-ip6', + 3 => 'server-name', + 4 => 'include-name', ); +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 $priority = $self->{SvcPriority}; - my @target = grep { $_ ne '.' } $self->{TargetName}->string; - my $mode = $priority ? 'DIRECT' : 'INCLUDE'; - my @rdata = join '=', $mode, @target; - push @rdata, "priority=$priority" if $priority > 1; - - my $params = $self->{SvcParams} || []; - my @params = @$params; - while (@params) { - my $key = join '', 'key', shift @params; - my $val = shift @params; + my @rdata; + my ($paramref) = grep {defined} $self->{parameters}, []; + my @parameters = @$paramref; + while (@parameters) { + my $key = shift @parameters; + my $val = shift @parameters; if ( my $name = $keyname{$key} ) { my @val = grep {length} $self->$name; - my @rhs = @val ? join ',', @val : @val; + my @rhs = grep {length} join ',', @val; push @rdata, join '=', $name, @rhs; } else { my @hex = unpack 'H*', $val; - $self->_annotation(qq(unexpected $key="@hex")); + $self->_annotation(qq[unexpected key$key="@hex"]); } } @@ -63,11 +92,10 @@ for ( my $rhs = /=$/ ? shift @argument : $1 ) { s/^"(.*)"$/$1/; # strip enclosing quotes s/\\,/\\044/g; # disguise escaped comma - push @value, length() ? split /,/ : ''; + push @value, length() ? split /,/ : (); } - s/[-]/_/g; # extract identifier - m/^([^=]+)/; + m/^([^=]+)/; # extract identifier $self->$1(@value); } return; @@ -77,132 +105,136 @@ sub _post_parse { ## parser post processing my $self = shift; - my $paramref = $self->{SvcParams} || []; - unless (@$paramref) { - return if $self->_empty; - die('no name or address specified') unless $self->targetname; + my ($paramref) = grep {defined} $self->{parameters}, []; + my %paramhash = @$paramref; + if ( defined $paramhash{3} ) { + die( $self->type . qq[: invalid $keyname{3}] ) + unless unpack 'xa*', $paramhash{3}; } - $self->SUPER::_post_parse; - return; -} - -sub _defaults { ## specify RR attribute default values - my $self = shift; - - $self->DIRECT; + if ( defined $paramhash{4} ) { + die( $self->type . qq[: invalid $keyname{4}] ) + unless unpack 'xa*', delete $paramhash{4}; + die( $self->type . qq[: parameter conflicts with $keyname{4}] ) + if scalar keys %paramhash; + } return; } -sub DIRECT { - my ( $self, @servername ) = @_; - $self->targetname( @servername, '.' ); - return $self->SvcPriority(1); -} - -sub INCLUDE { - my ( $self, $target ) = @_; - $self->targetname($target); - return $self->SvcPriority(0); -} - -sub priority { +sub server_ip4 { ## server-ip4=192.0.2.53 my ( $self, @value ) = @_; - my $priority = $self->{SvcPriority}; - return $priority unless @value; - my ($value) = @value; - if ($priority) { - die 'invalid zero priority' unless $value; - } else { - die 'invalid non-zero priority' if $value; - } - return $self->SvcPriority(@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 map { Net::DNS::RR::A::address( {address => $_} ) } @iplist; } -sub targetname { +sub server_ip6 { ## server-ip6=2001:DB8::53 my ( $self, @value ) = @_; - $self->{TargetName} = Net::DNS::DomainName->new(@value) if @value; - my $target = $self->{TargetName} ? $self->{TargetName}->name : return; - return $target eq '.' ? undef : $target; + return $self->_parameter( 2, _address6(@value) ) if @value; + my $packed = $self->_parameter(2) || return; + my @iplist = unpack 'a16' x ( length($packed) / 16 ), $packed; + return map { Net::DNS::RR::AAAA::address_short( {address => $_} ) } @iplist; } -sub ipv4 { ## IPv4=192.0.2.53,... +sub server_name { ## server-name=nameserver.example my ( $self, @value ) = @_; - my $packed = $self->_SvcParam( 4, _ipv4(@value) ); - return $packed if @value; - my @ip = unpack 'a4' x ( length($packed) / 4 ), $packed; - return map { bless( {address => $_}, 'Net::DNS::RR::A' )->address } @ip; + return $self->_parameter( 3, _domain(@value) ) if @value; + my $packed = $self->_parameter(3) || return; + return Net::DNS::DomainName->decode( \$packed )->fqdn; } -sub ipv6 { ## IPv6=2001:DB8::53,... +sub include_name { ## include-name=devolved.example my ( $self, @value ) = @_; - my $packed = $self->_SvcParam( 6, _ipv6(@value) ); - return $packed if @value; - my @ip = unpack 'a16' x ( length($packed) / 16 ), $packed; - return map { bless( {address => $_}, 'Net::DNS::RR::AAAA' )->address_short } @ip; + return $self->_parameter( 4, _domain(@value) ) if @value; + my $packed = $self->_parameter(4) || return; + return Net::DNS::DomainName->decode( \$packed )->fqdn; } -sub port { ## port=53 - my ( $self, @value ) = @_; - my $packed = $self->_SvcParam( 3, map { _integer16($_) } @value ); - return @value ? $packed : unpack 'n', $packed; -} -sub alpn { ## alpn=dot,doq - my ( $self, @value ) = @_; - my $packed = $self->_SvcParam( 1, _string(@value) ); - return $packed if @value; - my $index = 0; - while ( $index < length $packed ) { - ( my $text, $index ) = Net::DNS::Text->decode( \$packed, $index ); - push @value, $text->string; +######################################## + +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); } - return @value; -} -sub tls_supported_groups { ## tls_supported_groups=29,23 - my ( $self, @value ) = @_; # uncoverable pod - my $packed = $self->_SvcParam( 9, _integer16(@value) ); - return @value ? $packed : unpack 'n*', $packed; + my $super = "SUPER::$method"; + return $self->$super(@argument) unless $method =~ /^key[0]*(\d+)$/i; + die( $self->type . qq[: unsupported $method(...)] ) if @argument; + return $self->_parameter($1); } -sub generic { - my $self = shift; - my @ttl = grep {defined} $self->{ttl}; - my @class = map { $_ ? "CLASS$_" : () } $self->{class}; - my @core = ( $self->{owner}->string, @ttl, @class, "TYPE$self->{type}" ); - my @rdata = $self->_empty ? () : $self->SUPER::_format_rdata; - return join "\n\t", Net::DNS::RR::_wrap( "@core (", @rdata, ')' ); -} +sub _parameter { + my ( $self, $key, @argument ) = @_; + + my ($paramref) = grep {defined} $self->{parameters}, []; + my %parameter = @$paramref; + + if ( scalar @argument ) { + my $arg = shift @argument; # key($value); + my $tag = $keyname{$key} || ''; + delete $parameter{$key} unless defined $arg; + die( $self->type . qq[: duplicate parameter $tag] ) if defined $parameter{$key}; + die( $self->type . qq[: unexpected $tag 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) ? join( '', @arg ) : return @arg; + return scalar(@arg) > 1 ? join( '', @arg ) : @arg; } -sub _ipv4 { +sub _address4 { my @arg = @_; return _concatenate( map { Net::DNS::RR::A::address( {}, $_ ) } @arg ); } -sub _ipv6 { +sub _address6 { my @arg = @_; return _concatenate( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @arg ); } -sub _integer16 { +sub _domain { my @arg = @_; - return _concatenate( map { pack( 'n', $_ ) } @arg ); + return map { Net::DNS::DomainName->new($_)->encode() } @arg; } -sub _string { - my @arg = @_; - return _concatenate( map { Net::DNS::Text->new($_)->encode() } @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, ')' ); } ######################################## @@ -215,23 +247,19 @@ =head1 SYNOPSIS use Net::DNS; - $rr = Net::DNS::RR->new('zone DELEG DIRECT=nameserver IPv4=192.0.2.1'); - $rr = Net::DNS::RR->new('zone DELEG DIRECT IPv6=2001:db8::53'); - $rr = Net::DNS::RR->new('zone DELEG INCLUDE=targetname'); + $rr = Net::DNS::RR->new('zone DELEG server-ip4=192.0.2.1 ...'); + $rr = Net::DNS::RR->new('zone DELEG server-ip6=2001:db8::53 ...'); + $rr = Net::DNS::RR->new('zone DELEG server-name=nameserver.example ...'); + $rr = Net::DNS::RR->new('zone DELEG include-name=devolved.example'); =head1 DESCRIPTION - The DNS DELEG resource record set, wherever it appears, advertises the authoritative nameservers and transport parameters to be used to resolve queries for data at the owner name or any subordinate thereof. -The DELEG RRset is authoritative data within the delegating zone -and must not appear at the apex of the subordinate zone. - -The DELEG class is derived from, and inherits properties of, -the Net::DNS::RR::SVCB class. - +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 @@ -243,56 +271,40 @@ other unpredictable behaviour. -=head2 DIRECT - - example. DELEG DIRECT=nameserver - example. DELEG DIRECT=nameserver IPv6=2001:db8::53 - example. DELEG DIRECT IPv4=192.0.2.1 IPv6=2001:db8::53 - $nameserver = $rr->targetname; +=head2 server_ip4 -Specifies the nameserver domain name, which may be absent, -and sets DIRECT mode (non-zero SvcPriority). + eg.example. DELEG server-ip4=192.0.2.1,... + @ip = $rr->server_ip4; +Sets or gets a list of IP addresses. -=head2 INCLUDE - example. DELEG INCLUDE=targetname - $targetname = $rr->targetname; +=head2 server_ip6 -Specifies the location of an external nameserver configuration -and sets INCLUDE mode (zero SvcPriority). + eg.example. DELEG server-ip6=2001:db8::53,... + @ip = $rr->server_ip6; +Sets or gets a list of IP addresses. -=head2 priority - example. DELEG DIRECT=nameserver priority=123 - $priority = $rr->priority; +=head2 server_name -Gets or sets the priority value for the DELEG record. -An exception will be raised for any attempt to set -a non-zero priority for INCLUDE. + eg.example. DELEG server-name=nameserver.example. + $nameserver = $rr->server_name; +Specifies the domain name of the nameserver. -=head2 targetname +Returns the nameserver domain name or the undefined value if not specified. - $target = $rr->targetname; -Returns the target domain name or the undefined value if not specified. +=head2 include_name + eg.example. DELEG include-name=devolved.example. + $destination = $rr->include_name; -=head2 IPv4, ipv4 +Specifies the location of a devolved nameserver configuration. - example. DELEG DIRECT IPv4=192.0.2.1 - @ip = $rr->IPv4; - -Sets or gets the list of IP addresses. - -=head2 IPv6, ipv6 - - example. DELEG DIRECT IPv6=2001:db8::53 - @ip = $rr->IPv6; - -Sets or gets the list of IP addresses. +Returns the destination domain name or the undefined value if not specified. =head1 COPYRIGHT @@ -326,12 +338,6 @@ =head1 SEE ALSO L<perl> L<Net::DNS> L<Net::DNS::RR> -L<Net::DNS::RR::SVCB> - -draft-ietf-deleg - -L<RFC9460|https://iana.org/go/rfc9460> - -L<Service Parameter Keys|https://iana.org/assignments/dns-svcb> +draft-ietf-deleg-02 =cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/lib/Net/DNS/RR/SVCB.pm new/Net-DNS-1.53/lib/Net/DNS/RR/SVCB.pm --- old/Net-DNS-1.52/lib/Net/DNS/RR/SVCB.pm 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/lib/Net/DNS/RR/SVCB.pm 2025-08-29 14:17:53.000000000 +0200 @@ -2,7 +2,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: SVCB.pm 2033 2025-07-29 18:03:07Z willem $)[2]; +our $VERSION = (qw$Id: SVCB.pm 2037 2025-08-18 14:39:32Z willem $)[2]; use base qw(Net::DNS::RR); @@ -47,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; @@ -135,8 +133,7 @@ push @value, split /,/; } - s/[-]/_/g; # extract identifier - m/^([^=]+)/; + m/^([^=]+)/; # extract identifier $self->$1(@value); } } @@ -176,7 +173,7 @@ sub svcpriority { my ( $self, @value ) = @_; # uncoverable pod for (@value) { $self->{SvcPriority} = 0 + $_ } - return $self->{SvcPriority} || 0; + return $self->{SvcPriority}; } @@ -214,7 +211,7 @@ sub ipv4hint { ## ipv4hint=192.0.2.1,... my ( $self, @value ) = @_; - return $self->_SvcParam( 4, _ipv4(@value) ); + return $self->_SvcParam( 4, _address4(@value) ); } sub ech { ## ech=base64 @@ -224,7 +221,7 @@ sub ipv6hint { ## ipv6hint=2001:DB8::1,... my ( $self, @value ) = @_; - return $self->_SvcParam( 6, _ipv6(@value) ); + return $self->_SvcParam( 6, _address6(@value) ); } sub dohpath { ## dohpath=/dns-query{?dns} @@ -249,18 +246,19 @@ sub _concatenate { ## concatenate octet string(s) my @arg = @_; - return scalar(@arg) ? join( '', @arg ) : return (); + return scalar(@arg) ? join( '', @arg ) : @arg; } sub _boolean { my @arg = @_; return '' unless scalar @arg; - return shift(@arg) ? '' : undef; + return map { $_ ? '' : undef } @arg; } sub _string { my @arg = @_; - return _concatenate( map { Net::DNS::Text->new($_)->encode() } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { Net::DNS::Text->new($_)->encode() } @val ); } sub _base64 { @@ -270,17 +268,20 @@ sub _integer16 { my @arg = @_; - return _concatenate( map { pack( 'n', $_ ) } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { pack( 'n', $_ ) } @val ); } -sub _ipv4 { +sub _address4 { my @arg = @_; - return _concatenate( 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 _concatenate( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @arg ); + my @val = map { split /,/ } @arg; + return _concatenate( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @val ); } @@ -361,12 +362,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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/lib/Net/DNS/RR/TKEY.pm new/Net-DNS-1.53/lib/Net/DNS/RR/TKEY.pm --- old/Net-DNS-1.52/lib/Net/DNS/RR/TKEY.pm 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/lib/Net/DNS/RR/TKEY.pm 2025-08-29 14:17:53.000000000 +0200 @@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/lib/Net/DNS/RR.pm new/Net-DNS-1.53/lib/Net/DNS/RR.pm --- old/Net-DNS-1.52/lib/Net/DNS/RR.pm 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/lib/Net/DNS/RR.pm 2025-08-29 14:17:53.000000000 +0200 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = (qw$Id: RR.pm 2028 2025-07-22 16:52:42Z willem $)[2]; +our $VERSION = (qw$Id: RR.pm 2037 2025-08-18 14:39:32Z willem $)[2]; =head1 NAME @@ -326,16 +326,17 @@ 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 @@ -372,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 ); @@ -399,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 ); @@ -719,7 +721,7 @@ sub _annotation { my ( $self, @note ) = @_; - push @{$self->{annotation}}, "; @note", "\n" if scalar @note; + push @{$self->{annotation}}, "\t; @note" if scalar @note; return wantarray ? @{delete( $self->{annotation} ) || []} : undef; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/lib/Net/DNS.pm new/Net-DNS-1.53/lib/Net/DNS.pm --- old/Net-DNS-1.52/lib/Net/DNS.pm 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/lib/Net/DNS.pm 2025-08-29 14:17:53.000000000 +0200 @@ -4,9 +4,9 @@ use warnings; our $VERSION; -$VERSION = '1.52'; +$VERSION = '1.53'; $VERSION = eval {$VERSION}; -our $SVNVERSION = (qw$Id: DNS.pm 2034 2025-07-29 18:04:34Z willem $)[2]; +our $SVNVERSION = (qw$Id: DNS.pm 2041 2025-08-29 12:11:41Z willem $)[2]; =head1 NAME diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/t/03-rr.t new/Net-DNS-1.53/t/03-rr.t --- old/Net-DNS-1.52/t/03-rr.t 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/t/03-rr.t 2025-08-29 14:17:53.000000000 +0200 @@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/t/04-packet.t new/Net-DNS-1.53/t/04-packet.t --- old/Net-DNS-1.52/t/04-packet.t 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/t/04-packet.t 2025-08-29 14:17:53.000000000 +0200 @@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/t/05-DELEG.t new/Net-DNS-1.53/t/05-DELEG.t --- old/Net-DNS-1.52/t/05-DELEG.t 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/t/05-DELEG.t 2025-08-29 14:17:53.000000000 +0200 @@ -1,11 +1,10 @@ #!/usr/bin/perl -# $Id: 05-DELEG.t 2033 2025-07-29 18:03:07Z willem $ -*-perl-*- +# $Id: 05-DELEG.t 2039 2025-08-26 09:01:09Z willem $ -*-perl-*- # use strict; use warnings; use Net::DNS; -use Net::DNS::ZoneFile; use Test::More; use TestToolkit; @@ -14,66 +13,89 @@ unless ( $] > 5.018001 ) or ( $] < 5.018 ); -plan tests => 28; +plan tests => 48; my $type = 'DELEG'; -my $code = $Net::DNS::Parameters::typebyname{$type}; 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" ); -for my $rr ( Net::DNS::RR->new( my $record = 'example. IN DELEG' ) ) { +for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG' ) ) { ok( $rr, "new DELEG RR: $record" ); - is( $rr->priority, undef, 'undefined priority' ); - is( $rr->targetname, undef, 'undefined targetname' ); + is( $rr->server_ip4, undef, 'server_ip4 undefined' ); + is( $rr->server_ip6, undef, 'server_ip6 undefined' ); + is( $rr->server_name, undef, 'server_name undefined' ); + is( $rr->include_name, undef, 'include_name undefined' ); + is( $rr->rdata, '', 'empty rdata' ); ok( $rr->string, 'presentation format string' ); ok( $rr->generic, 'RFC3597 generic format' ); } -for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG DIRECT=servername' ) ) { - ok( $rr, "new DELEG RR: $record" ); - isnt( $rr->priority, 0, 'non-zero priority' ); - ok( $rr->targetname, 'defined targetname' ); - ok( $rr->string, 'presentation format string' ); - ok( $rr->generic, 'RFC3597 generic format' ); +for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG server-ip4=192.0.2.1,192.0.2.2' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key1(), 'correct parameter key defined' ); + my @list = eval { $rr->server_ip4 }; + ok( scalar @list, '$rr->server_ip4 returns address list' ); + is( $rr->include_name, undef, 'include_name undefined' ); } - -for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG DIRECT=servername IPv4=192.0.2.1 port=53 key65534' ) ) { - ok( $rr, "new DELEG RR: $record" ); - is( $rr->priority, 1, 'default priority 1' ); - ok( $rr->priority(123), 'set arbitrary priority' ); - is( $rr->priority, 123, 'verify changed priority' ); - exception( 'zero priority value rejected', sub { $rr->priority(0) } ); - ok( $rr->string, 'presentation format string' ); +for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG server-ip6=2001:db8::1' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key2(), 'correct parameter key defined' ); + my @list = eval { $rr->server_ip6 }; + ok( scalar @list, '$rr->server_ip6 returns address list' ); + is( $rr->include_name, undef, 'include_name undefined' ); } +for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG server-name=nameserver.example' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key3(), 'correct parameter key defined' ); + is( $rr->server_name, 'nameserver.example.', '$rr->server_name returns domain name' ); + is( $rr->include_name, undef, 'include_name undefined' ); +} -for my $rr ( - Net::DNS::RR->new( - my $record = 'example. DELEG IPv6=2001:db8::53 alpn=dot key2 tls-supported-groups=29' - ) - ) { - ok( $rr, "new DELEG RR: $record" ); - is( $rr->targetname, undef, 'undefined targetname' ); - ok( $rr->string, 'presentation format string' ); +for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG include-name="devolved.example"' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key4(), 'correct parameter key defined' ); + is( $rr->include_name, 'devolved.example.', '$rr->include_name returns domain name' ); + is( $rr->server_name, undef, 'server_name undefined' ); + is( $rr->server_ip4, undef, 'server_ip4 undefined' ); + is( $rr->server_ip6, undef, 'server_ip6 undefined' ); } -for my $rr ( Net::DNS::RR->new( my $record = 'example. DELEG INCLUDE="targetname"' ) ) { +for my $rr ( Net::DNS::RR->new( my $record = 'example. 0 IN DELEG' ) ) { ok( $rr, "new DELEG RR: $record" ); - is( $rr->priority, 0, 'zero priority' ); - ok( $rr->targetname, 'defined targetname' ); - ok( $rr->string, 'presentation format string' ); - is( $rr->priority(0), 0, 'zero priority silently accepted' ); - exception( 'non-zero priority rejected', sub { $rr->priority(1) } ); + is( $rr->rdata, '', 'empty rdata' ); + ok( $rr->server_ip4('192.0.2.1'), 'server_ip4 write access method' ); + ok( $rr->server_ip6('2001:db8::53'), 'server_ip6 write access method' ); + ok( $rr->server_name('nameserver.example.'), 'server_name write access method' ); + ok( $rr->include_name('devolved.example.'), 'include_name write access method' ); + ok( $rr->rdata, 'non-empty rdata' ); + ok( $rr->encode, 'wire-format octet string' ); + ok( !$rr->_parameter( 4, undef ), 'delete include_name 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( 'incomplete INCLUDE parameter', sub { Net::DNS::RR->new('example. DELEG INCLUDE') } ); -exception( 'incomplete DIRECT parameter set', sub { Net::DNS::RR->new('example. DELEG DIRECT') } ); + +exception( 'duplicated parameter', sub { Net::DNS::RR->new('example. DELEG include-name=x include-name=y') } ); +exception( 'incompatible parameter', sub { Net::DNS::RR->new('example. DELEG include-name=x server-name=y') } ); +exception( 'invalid argument', sub { Net::DNS::RR->new('example. DELEG include-name=.') } ); +exception( 'invalid argument', sub { Net::DNS::RR->new('example. DELEG server-name=.') } ); +exception( 'unexpected arguments', sub { Net::DNS::RR->new('example. DELEG server-name=x,y') } ); +exception( 'unsupported parameter', sub { Net::DNS::RR->new('example. DELEG')->key65500('') } ); +exception( 'unrecognised parameter', sub { Net::DNS::RR->new('example. DELEG bogus') } ); exit; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/t/05-NULL.t new/Net-DNS-1.53/t/05-NULL.t --- old/Net-DNS-1.52/t/05-NULL.t 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/t/05-NULL.t 2025-08-29 14:17:53.000000000 +0200 @@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Net-DNS-1.52/t/05-SVCB.t new/Net-DNS-1.53/t/05-SVCB.t --- old/Net-DNS-1.52/t/05-SVCB.t 2025-07-29 20:04:54.000000000 +0200 +++ new/Net-DNS-1.53/t/05-SVCB.t 2025-08-29 14:17:53.000000000 +0200 @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $Id: 05-SVCB.t 2028 2025-07-22 16:52:42Z willem $ -*-perl-*- +# $Id: 05-SVCB.t 2035 2025-08-14 11:49:15Z willem $ -*-perl-*- # use strict; @@ -14,68 +14,92 @@ unless ( $] > 5.018001 ) or ( $] < 5.018 ); -plan tests => 50; +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(key0 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. SVCB' ) ) { + ok( $rr, "new DELEG 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. SVCB 0 target.example.' ) ) { + ok( $rr, "new DELEG 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. SVCB 1 target.example.' ) ) { + ok( $rr, "new DELEG 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. SVCB 1 .' ) ) { + ok( $rr, "new DELEG 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. SVCB 1 . mandatory=alpn alpn=h2,h3' ) ) { + ok( $rr, "new DELEG 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. SVCB 1 . alpn=h2,h3 no-default-alpn' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key1(), 'correct SvcParameter key defined' ); + ok( defined $rr->no_default_alpn, '$rr->no_default_alpn true' ); +} - exception( 'non-existent method', sub { $rr->bogus } ); +for my $rr ( Net::DNS::RR->new( my $record = 'example. SVCB 1 . port=53' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key3(), 'correct SvcParameter key defined' ); } +for my $rr ( Net::DNS::RR->new( my $record = 'example. SVCB 1 . ipv4hint=192.0.2.1' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key4(), '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. SVCB 1 . ech=Base64format' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key5(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = 'example. SVCB 1 . ipv6hint=192.0.2.1' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key6(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = 'example. SVCB 1 . dohpath=/dns-query{?dns}' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key7(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = 'example. SVCB 1 . ohttp=0 ohttp=1' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key8(), 'correct SvcParameter key defined' ); +} + +for my $rr ( Net::DNS::RR->new( my $record = 'example. SVCB 1 . tls-supported-groups=29,23' ) ) { + ok( $rr, "new DELEG RR: $record" ); + ok( defined $rr->key9(), 'correct SvcParameter key defined' ); } @@ -91,6 +115,22 @@ END +for my $rr ( Net::DNS::RR->new('example. SVCB 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 ); ++++++ _scmsync.obsinfo ++++++ --- /var/tmp/diff_new_pack.Hcslgj/_old 2025-10-10 17:08:22.582784059 +0200 +++ /var/tmp/diff_new_pack.Hcslgj/_new 2025-10-10 17:08:22.590784396 +0200 @@ -1,6 +1,6 @@ -mtime: 1755516054 -commit: 148abe710b39671ffef82c34d46aaddbb08b9ae7bf03ff156617df7320f8416b +mtime: 1759844047 +commit: aace4744ba00af87361c382e970c828f08ec8c814c67b7cd926fb3ba85432843 url: https://src.opensuse.org/perl/perl-Net-DNS.git -revision: 148abe710b39671ffef82c34d46aaddbb08b9ae7bf03ff156617df7320f8416b +revision: aace4744ba00af87361c382e970c828f08ec8c814c67b7cd926fb3ba85432843 projectscmsync: https://src.opensuse.org/perl/_ObsPrj ++++++ build.specials.obscpio ++++++ ++++++ build.specials.obscpio ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/.gitignore new/.gitignore --- old/.gitignore 1970-01-01 01:00:00.000000000 +0100 +++ new/.gitignore 2025-10-09 16:29:19.000000000 +0200 @@ -0,0 +1 @@ +.osc
