Файловый менеджер - Редактировать - /var/www/html/RR.zip
Ðазад
PK ! ƅ�_� � EUI48.pmnu �[��� package Net::DNS::RR::EUI48; use strict; use warnings; our $VERSION = (qw$Id: EUI48.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::EUI48 - DNS EUI48 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a6", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'a6', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return $self->address; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); return; } sub address { my ( $self, $address ) = @_; $self->{address} = pack 'C6', map { hex($_) } split /[:-]/, $address if $address; return defined(wantarray) ? join( '-', unpack 'H2H2H2H2H2H2', $self->{address} ) : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN EUI48 address'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'EUI48', address => '00-00-5e-00-53-2a' ); =head1 DESCRIPTION DNS resource records for 48-bit Extended Unique Identifier (EUI48). The EUI48 resource record is used to represent IEEE Extended Unique Identifiers used in various layer-2 networks, ethernet for example. EUI48 addresses SHOULD NOT be published in the public DNS. RFC7043 describes potentially severe privacy implications resulting from indiscriminate publication of link-layer addresses in the DNS. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address The address field is a 6-octet layer-2 address in network byte order. The presentation format is hexadecimal separated by "-". =head1 COPYRIGHT Copyright (c)2013 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7043 =cut PK ! ��a a AFSDB.pmnu �[��� package Net::DNS::RR::AFSDB; use strict; use warnings; our $VERSION = (qw$Id: AFSDB.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::AFSDB - DNS AFSDB resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{subtype} = unpack "\@$offset n", $$data; $self->{hostname} = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $hostname = $self->{hostname}; return pack 'n a*', $self->subtype, $hostname->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $hostname = $self->{hostname}; return join ' ', $self->subtype, $hostname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->subtype(shift); $self->hostname(shift); return; } sub subtype { my $self = shift; $self->{subtype} = 0 + shift if scalar @_; return $self->{subtype} || 0; } sub hostname { my $self = shift; $self->{hostname} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{hostname} ? $self->{hostname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name AFSDB subtype hostname'); =head1 DESCRIPTION Class for DNS AFS Data Base (AFSDB) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 subtype $subtype = $rr->subtype; $rr->subtype( $subtype ); A 16 bit integer which indicates the service offered by the listed host. =head2 hostname $hostname = $rr->hostname; $rr->hostname( $hostname ); The hostname field is a domain name of a host that has a server for the cell named by the owner name of the RR. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183, RFC5864 =cut PK ! +�V� 6 6 OPT.pmnu �[��� package Net::DNS::RR::OPT; use strict; use warnings; our $VERSION = (qw$Id: OPT.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::OPT - DNS OPT resource record =cut use integer; use Carp; use Net::DNS::Parameters qw(:rcode :ednsoption); use constant CLASS_TTL_RDLENGTH => length pack 'n N n', (0) x 3; use constant OPT => Net::DNS::Parameters::typebyname qw(OPT); require Net::DNS::DomainName; require Net::DNS::RR::A; require Net::DNS::RR::AAAA; require Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $index = $offset - CLASS_TTL_RDLENGTH; # OPT redefines class and TTL fields @{$self}{qw(size rcode version flags)} = unpack "\@$index n C2 n", $$data; @{$self}{rcode} = @{$self}{rcode} << 4; delete @{$self}{qw(class ttl)}; my $limit = $offset + $self->{rdlength} - 4; while ( $offset <= $limit ) { my ( $code, $length ) = unpack "\@$offset nn", $$data; my $value = unpack "\@$offset x4 a$length", $$data; $self->{option}{$code} = $value; $offset += $length + 4; } return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $option = $self->{option} || {}; return join '', map { pack( 'nna*', $_, length $option->{$_}, $option->{$_} ) } keys %$option; } sub encode { ## overide RR method my $self = shift; my $data = $self->_encode_rdata; my $size = $self->size; my @xttl = ( $self->rcode >> 4, $self->version, $self->flags ); return pack 'C n n C2n n a*', 0, OPT, $size, @xttl, length($data), $data; } sub string { ## overide RR method my $self = shift; my $edns = $self->version; my $flags = sprintf '%04x', $self->flags; my $rcode = $self->rcode; my $size = $self->size; my @option = map { join( "\n;;\t\t\t\t", $self->_format_option($_) ) } $self->options; my @format = join "\n;;\t\t", @option; $rcode = 0 if $rcode < 16; # weird: 1 .. 15 not EDNS codes!! my $rc = exists( $self->{rdlength} ) && $rcode ? "$rcode + [4-bits]" : rcodebyval($rcode); $rc = 'BADVERS' if $rcode == 16; # code 16 unambiguous here return <<"QQ"; ;; EDNS version $edns ;; flags: $flags ;; rcode: $rc ;; size: $size ;; option: @format QQ } sub class { ## overide RR method my $self = shift; $self->_deprecate(qq[please use "size()"]); return $self->size(@_); } sub ttl { ## overide RR method my $self = shift; $self->_deprecate(qq[please use "flags()" or "rcode()"]); my @rcode = map { unpack( 'C', pack 'N', $_ ) } @_; my @flags = map { unpack( 'x2n', pack 'N', $_ ) } @_; return pack 'C2n', $self->rcode(@rcode), $self->version, $self->flags(@flags); } sub version { my $self = shift; $self->{version} = 0 + shift if scalar @_; return $self->{version} || 0; } sub size { my $self = shift; $self->{size} = shift if scalar @_; return ( $self->{size} || 0 ) > 512 ? $self->{size} : 512; } sub rcode { my $self = shift; return $self->{rcode} || 0 unless scalar @_; delete $self->{rdlength}; # (ab)used to signal incomplete value my $val = shift || 0; return $self->{rcode} = $val < 16 ? 0 : $val; # discard non-EDNS rcodes 1 .. 15 } sub flags { my $self = shift; $self->{flags} = shift if scalar @_; return $self->{flags} || 0; } sub options { my ($self) = @_; my $option = $self->{option} || {}; my @option = sort { $a <=> $b } keys %$option; return @option; } sub option { my $self = shift; my $number = ednsoptionbyname(shift); return $self->_get_option($number) unless scalar @_; return $self->_set_option( $number, @_ ); } sub _format_option { my ( $self, $number ) = @_; my $option = ednsoptionbyval($number); my $options = $self->{option} || {}; my $payload = $options->{$number}; return () unless defined $payload; my $package = join '::', __PACKAGE__, $option; $package =~ s/-/_/g; my $defined = length($payload) && $package->can('_image'); my @element = $defined ? eval { $package->_image($payload) } : unpack 'H*', $payload; my $protect = pop(@element); return Net::DNS::RR::_wrap( "$option\t=> (", map( {"$_,"} @element ), "$protect )" ); } sub _get_option { my ( $self, $number ) = @_; my $options = $self->{option} || {}; my $payload = $options->{$number}; return $payload unless wantarray; return () unless $payload; my $package = join '::', __PACKAGE__, ednsoptionbyval($number); $package =~ s/-/_/g; return ( 'OPTION-DATA' => $payload ) unless $package->can('_decompose'); return eval { $package->_decompose($payload) }; } sub _set_option { my ( $self, $number, $value, @etc ) = @_; my $options = $self->{option} ||= {}; delete $options->{$number}; return unless defined $value; if ( ref($value) || scalar(@etc) || $value !~ /\D/ ) { my @arg = ( $value, @etc ); @arg = @$value if ref($value) eq 'ARRAY'; @arg = %$value if ref($value) eq 'HASH'; if ( $arg[0] eq 'OPTION-DATA' ) { $value = $arg[1]; } else { my $option = ednsoptionbyval($number); my $package = join '::', __PACKAGE__, $option; $package =~ s/-/_/g; if ( $package->can('_compose') ) { $value = $package->_compose(@arg); } elsif ( scalar(@etc) ) { croak "unable to compose option $option"; } } } return $options->{$number} = $value; } sub _specified { my $self = shift; return scalar grep { $self->{$_} } qw(size flags rcode option); } ######################################## ## no critic ProhibitMultiplePackages package Net::DNS::RR::OPT::DAU; # RFC6975 sub _compose { shift; return pack 'C*', @_; } sub _decompose { my @payload = unpack 'C*', $_[1]; return @payload; } sub _image { return &_decompose; } package Net::DNS::RR::OPT::DHU; # RFC6975 our @ISA = qw(Net::DNS::RR::OPT::DAU); package Net::DNS::RR::OPT::N3U; # RFC6975 our @ISA = qw(Net::DNS::RR::OPT::DAU); package Net::DNS::RR::OPT::CLIENT_SUBNET; # RFC7871 my %family = qw(0 Net::DNS::RR::AAAA 1 Net::DNS::RR::A 2 Net::DNS::RR::AAAA); my @field8 = qw(FAMILY SOURCE-PREFIX-LENGTH SCOPE-PREFIX-LENGTH ADDRESS); sub _compose { my ( $class, %argument ) = ( map( ( $_ => 0 ), @field8 ), @_ ); my $address = bless( {}, $family{$argument{FAMILY}} )->address( $argument{ADDRESS} ); my $bitmask = $argument{'SOURCE-PREFIX-LENGTH'}; pack "a* B$bitmask", pack( 'nC2', @argument{@field8} ), unpack 'B*', $address; } sub _decompose { my %hash; @hash{@field8} = unpack 'nC2a*', $_[1]; $hash{ADDRESS} = bless( {address => $hash{ADDRESS}}, $family{$hash{FAMILY}} )->address; my @payload = map( ( $_ => $hash{$_} ), @field8 ); } sub _image { my %hash = &_decompose; my @image = map "$_ => $hash{$_}", @field8; } package Net::DNS::RR::OPT::EXPIRE; # RFC7314 sub _compose { my ( $class, %argument ) = @_; pack 'N', values %argument; } sub _decompose { my @payload = ( 'EXPIRE-TIMER' => unpack 'N', $_[1] ); } sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::COOKIE; # RFC7873 my @field10 = qw(VERSION RESERVED TIMESTAMP HASH); sub _compose { my ( $class, %argument ) = ( VERSION => 1, RESERVED => '', @_ ); return pack 'a8', $argument{'CLIENT-COOKIE'} if $argument{'CLIENT-COOKIE'}; pack 'Ca3Na*', map $_, @argument{@field10}; } sub _decompose { my ( $class, $argument ) = @_; return ( 'CLIENT-COOKIE', $argument ) unless length($argument) > 8; my %hash; @hash{@field10} = unpack 'Ca3Na*', $argument; my @payload = map( ( $_ => $hash{$_} ), @field10 ); } sub _image { my %hash = &_decompose; return unpack 'H*', $hash{'CLIENT-COOKIE'} if $hash{'CLIENT-COOKIE'}; for (qw(RESERVED HASH)) { $hash{$_} = unpack 'H*', $hash{$_} } my @image = map "$_ => $hash{$_}", @field10; } package Net::DNS::RR::OPT::TCP_KEEPALIVE; # RFC7828 sub _compose { my ( $class, %argument ) = @_; pack 'n', values %argument; } sub _decompose { my @payload = ( 'TIMEOUT' => unpack 'n', $_[1] ); } sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::PADDING; # RFC7830 sub _compose { my ( $class, %argument ) = @_; my ($size) = values %argument; pack "x$size"; } sub _decompose { my @payload = ( 'OPTION-LENGTH' => length( $_[1] ) ); } sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::CHAIN; # RFC7901 sub _compose { my ( $class, %argument ) = @_; my ($trust_point) = values %argument; Net::DNS::DomainName->new($trust_point)->encode; } sub _decompose { my ( $class, $payload ) = @_; my $fqdn = Net::DNS::DomainName->decode( \$payload )->string; my @payload = ( 'CLOSEST-TRUST-POINT' => $fqdn ); } sub _image { join ' => ', &_decompose; } package Net::DNS::RR::OPT::KEY_TAG; # RFC8145 sub _compose { shift; pack 'n*', @_; } sub _decompose { my @payload = unpack 'n*', $_[1]; } sub _image { &_decompose; } package Net::DNS::RR::OPT::EXTENDED_ERROR; # RFC8914 my @field15 = qw(INFO-CODE EXTRA-TEXT); sub _compose { my ( $class, %argument ) = ( 'INFO-CODE' => 0, 'EXTRA-TEXT' => '', @_ ); my ( $code, $text ) = @argument{@field15}; pack 'na*', $code, Net::DNS::Text->new($text)->raw; } sub _decompose { my ( $code, $text ) = unpack 'na*', $_[1]; my @payload = ( 'INFO-CODE' => $code, 'EXTRA-TEXT' => Net::DNS::Text->decode( \$text, 0, length $text )->string ); } sub _image { my %hash = &_decompose; my @image = map "$_ => $hash{$_}", @field15; } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $packet = Net::DNS::Packet->new( ... ); $packet->header->do(1); # extended flag $packet->edns->size(1280); # UDP payload size $packet->edns->option( COOKIE => 'rawbytes' ); $packet->edns->print; ;; EDNS version 0 ;; flags: 8000 ;; rcode: NOERROR ;; size: 1280 ;; option: COOKIE => ( 7261776279746573 ) ;; DAU => ( 8, 10, 13, 14, 15, 16 ) ;; DHU => ( 1, 2, 4 ) ;; EXTENDED-ERROR => ( INFO-CODE => 123, EXTRA-TEXT => ) =head1 DESCRIPTION EDNS OPT pseudo resource record. The OPT record supports EDNS protocol extensions and is not intended to be created, accessed or modified directly by user applications. All EDNS features are performed indirectly by operations on the objects returned by the $packet->header and $packet->edns creator methods. The underlying mechanisms are entirely hidden from the user. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 version $version = $rr->version; $rr->version( $version ); The version of EDNS supported by this OPT record. =head2 size $size = $packet->edns->size; $more = $packet->edns->size(1280); size() advertises the maximum size (octets) of UDP packet that can be reassembled in the network stack of the originating host. =head2 rcode $extended_rcode = $packet->header->rcode; $incomplete_rcode = $packet->edns->rcode; The 12 bit extended RCODE. The most significant 8 bits reside in the OPT record. The least significant 4 bits can only be obtained from the packet header. =head2 flags $edns_flags = $packet->edns->flags; $do = $packet->header->do; $packet->header->do(1); 16 bit field containing EDNS extended header flags. =head2 options, option @option = $packet->edns->options; $octets = $packet->edns->option($option_code); $packet->edns->option( COOKIE => $octets ); $packet->edns->option( 10 => $octets ); When called in a list context, options() returns a list of option codes found in the OPT record. When called in a scalar context with a single argument, option() returns the uninterpreted octet string corresponding to the specified option. The method returns undef if the specified option is absent. Options can be added or replaced by providing the (name => value) pair. The option is deleted if the value is undefined. When option() is called in a list context with a single argument, the returned values provide a structured interpretation appropriate to the specified option. For example: @algorithms = $packet->edns->option('DAU'); For some options, a hash table is more convenient: %hash_table = $packet->edns->option(15); $info_code = $hash_table{'INFO-CODE'}; $extra_text = $hash_table{'EXTRA-TEXT'}; Similar forms of array or hash syntax may be used to construct the option value: $packet->edns->option( DHU => [1, 2, 4] ); $packet->edns->option( EXPIRE => {'EXPIRE-TIMER' => 604800} ); =head1 COPYRIGHT Copyright (c)2001,2002 RIPE NCC. Author Olaf M. Kolkman. Portions Copyright (c)2012,2017-2020 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6891, RFC3225 =cut PK ! ���� � PTR.pmnu �[��� package Net::DNS::RR::PTR; use strict; use warnings; our $VERSION = (qw$Id: PTR.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::PTR - DNS PTR resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{ptrdname} = Net::DNS::DomainName1035->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $ptrdname = $self->{ptrdname}; return $ptrdname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $ptrdname = $self->{ptrdname}; return $ptrdname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->ptrdname(shift); return; } sub ptrdname { my $self = shift; $self->{ptrdname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{ptrdname} ? $self->{ptrdname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name PTR ptrdname'); =head1 DESCRIPTION Class for DNS Pointer (PTR) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 ptrdname $ptrdname = $rr->ptrdname; $rr->ptrdname( $ptrdname ); A domain name which points to some location in the domain name space. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.12 =cut PK ! e_�/ DHCID.pmnu �[��� package Net::DNS::RR::DHCID; use strict; use warnings; our $VERSION = (qw$Id: DHCID.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DHCID - DNS DHCID resource record =cut use integer; use MIME::Base64; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = $self->{rdlength} - 3; @{$self}{qw(identifiertype digesttype digest)} = unpack "\@$offset nC a$size", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'nC a*', map { $self->$_ } qw(identifiertype digesttype digest); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = split /\s+/, encode_base64( $self->_encode_rdata ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my $data = MIME::Base64::decode( join "", @_ ); my $size = length($data) - 3; @{$self}{qw(identifiertype digesttype digest)} = unpack "n C a$size", $data; return; } # +------------------+------------------------------------------------+ # | Identifier Type | Identifier | # | Code | | # +------------------+------------------------------------------------+ # | 0x0000 | The 1-octet 'htype' followed by 'hlen' octets | # | | of 'chaddr' from a DHCPv4 client's DHCPREQUEST | # | | [7]. | # | 0x0001 | The data octets (i.e., the Type and | # | | Client-Identifier fields) from a DHCPv4 | # | | client's Client Identifier option [10]. | # | 0x0002 | The client's DUID (i.e., the data octets of a | # | | DHCPv6 client's Client Identifier option [11] | # | | or the DUID field from a DHCPv4 client's | # | | Client Identifier option [6]). | # | 0x0003 - 0xfffe | Undefined; available to be assigned by IANA. | # | 0xffff | Undefined; RESERVED. | # +------------------+------------------------------------------------+ sub identifiertype { my $self = shift; $self->{identifiertype} = 0 + shift if scalar @_; return $self->{identifiertype} || 0; } sub digesttype { my $self = shift; $self->{digesttype} = 0 + shift if scalar @_; return $self->{digesttype} || 0; } sub digest { my $self = shift; $self->{digest} = shift if scalar @_; return $self->{digest} || ""; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('client.example.com. DHCID ( AAAB xLmlskllE0MVjd57zHcWmEH3pCQ6VytcKD//7es/deY='); $rr = Net::DNS::RR->new( name => 'client.example.com', type => 'DHCID', digest => 'ObfuscatedIdentityData', digesttype => 1, identifiertype => 2, ); =head1 DESCRIPTION DNS RR for Encoding DHCP Information (DHCID) =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 identifiertype $identifiertype = $rr->identifiertype; $rr->identifiertype( $identifiertype ); The 16-bit identifier type describes the form of host identifier used to construct the DHCP identity information. =head2 digesttype $digesttype = $rr->digesttype; $rr->digesttype( $digesttype ); The 8-bit digest type number describes the message-digest algorithm used to obfuscate the DHCP identity information. =head2 digest $digest = $rr->digest; $rr->digest( $digest ); Binary representation of the digest of DHCP identity information. =head1 COPYRIGHT Copyright (c)2009 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4701 =cut PK ! 3�e�! ! NULL.pmnu �[��� package Net::DNS::RR::NULL; use strict; use warnings; our $VERSION = (qw$Id: NULL.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NULL - DNS NULL resource record =cut 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name NULL \# length hexdata ...'); =head1 DESCRIPTION Class for DNS null (NULL) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 rdlength $rdlength = $rr->rdlength; Returns the length of the record data section. =head2 rdata $rdata = $rr->rdata; $rr->rdata( $rdata ); Returns the record data section as binary data. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.10 =cut PK ! +���� � AAAA.pmnu �[��� package Net::DNS::RR::AAAA; use strict; use warnings; our $VERSION = (qw$Id: AAAA.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::AAAA - DNS AAAA resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a16", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'a16', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return $self->address_short; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); return; } sub address_long { my $addr = pack 'a*@16', grep {defined} shift->{address}; return sprintf '%x:%x:%x:%x:%x:%x:%x:%x', unpack 'n8', $addr; } sub address_short { my $addr = pack 'a*@16', grep {defined} shift->{address}; local $_ = sprintf ':%x:%x:%x:%x:%x:%x:%x:%x:', unpack 'n8', $addr; s/(:0[:0]+:)(?!.+:0\1)/::/; # squash longest zero sequence s/^:// unless /^::/; # prune LH : s/:$// unless /::$/; # prune RH : return $_; } sub address { my $self = shift; return address_long($self) unless scalar @_; my $addr = shift; my @parse = split /:/, "0$addr"; if ( (@parse)[$#parse] =~ /\./ ) { # embedded IPv4 my @ip4 = split /\./, pop(@parse); my $rhs = pop(@ip4); my @ip6 = map { /./ ? hex($_) : (0) x ( 7 - @parse ) } @parse; return $self->{address} = pack 'n6 C4', @ip6, @ip4, (0) x ( 3 - @ip4 ), $rhs; } # Note: pack() masks overlarge values, mostly without warning. my @expand = map { /./ ? hex($_) : (0) x ( 9 - @parse ) } @parse; return $self->{address} = pack 'n8', @expand; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN AAAA address'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'AAAA', address => '2001:DB8::8:800:200C:417A' ); =head1 DESCRIPTION Class for DNS IPv6 Address (AAAA) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address $IPv6_address = $rr->address; Returns the text representation of the IPv6 address. =head2 address_long $IPv6_address = $rr->address_long; Returns the text representation specified in RFC3513, 2.2(1). =head2 address_short $IPv6_address = $rr->address_short; Returns the textual form of address recommended by RFC5952. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2003 Chris Reinhardt. Portions Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC3596, RFC3513, RFC5952 =cut PK ! ]��B B AMTRELAY.pmnu �[��� package Net::DNS::RR::AMTRELAY; use strict; use warnings; our $VERSION = (qw$Id: AMTRELAY.pm 1855 2021-11-26 11:33:48Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::AMTRELAY - DNS AMTRELAY resource record =cut use integer; use Carp; use Net::DNS::DomainName; use Net::DNS::RR::A; use Net::DNS::RR::AAAA; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = $self->{rdlength} - 2; @{$self}{qw(precedence relaytype relay)} = unpack "\@$offset C2 a$size", $$data; for ( $self->relaytype ) { /^3$/ && return $self->{relay} = Net::DNS::DomainName->decode( $data, $offset + 2 ); /^2$/ && return $self->{relay} = pack( 'a16', $self->{relay} ); /^1$/ && return $self->{relay} = pack( 'a4', $self->{relay} ); } $self->{relay} = ''; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; for ( $self->relaytype ) { /^3$/ && return pack( 'C2 a*', @{$self}{qw(precedence relaytype)}, $self->{relay}->encode ); /^2$/ && return pack( 'C2 a16', @{$self}{qw(precedence relaytype relay)} ); /^1$/ && return pack( 'C2 a4', @{$self}{qw(precedence relaytype relay)} ); } return pack( 'C2', @{$self}{qw(precedence relaytype)} ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = map { $self->$_ } qw(precedence dbit relaytype relay); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(precedence dbit relaytype relay)) { $self->$_(shift); } return; } sub _defaults { ## specify RR attribute default values my $self = shift; @{$self}{qw(precedence relaytype relay)} = ( 0, 0, '' ); return; } sub precedence { my $self = shift; $self->{precedence} = 0 + shift if scalar @_; return $self->{precedence} || 0; } sub dbit { my $self = shift; # uncoverable pod $self->{relaytype} = $self->relaytype | ( $_[0] ? 0x80 : 0 ) if scalar @_; return ( $self->{relaytype} || 0 ) >> 7; } sub d {&dbit} # uncoverable pod sub relaytype { my $self = shift; $self->{relaytype} = $self->dbit ? ( 0x80 | shift ) : shift if scalar @_; return 0x7f & ( $self->{relaytype} || 0 ); } sub relay { my $self = shift; for (@_) { /^\.*$/ && do { $self->relaytype(0); $self->{relay} = ''; # no relay last; }; /:.*:/ && do { $self->relaytype(2); $self->{relay} = Net::DNS::RR::AAAA::address( {}, $_ ); last; }; /\.\d+$/ && do { $self->relaytype(1); $self->{relay} = Net::DNS::RR::A::address( {}, $_ ); last; }; /\..+/ && do { $self->relaytype(3); $self->{relay} = Net::DNS::DomainName->new($_); last; }; croak 'unrecognised relay type'; } if ( defined wantarray ) { for ( $self->relaytype ) { /^1$/ && return Net::DNS::RR::A::address( {address => $self->{relay}} ); /^2$/ && return Net::DNS::RR::AAAA::address( {address => $self->{relay}} ); /^3$/ && return wantarray ? $self->{relay}->string : $self->{relay}->name; } } return wantarray ? '.' : undef; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('owner AMTRELAY precedence Dbit relaytype relay'); =head1 DESCRIPTION AMTRELAY resource record designed to permit DNS Reverse IP AMT Discovery (DRIAD), a mechanism for AMT gateways to discover AMT relays that are capable of forwarding multicast traffic from a known source IP address. AMT (Automatic Multicast Tunneling) is defined in RFC7450 and provides a method to transport multicast traffic over a unicast tunnel in order to traverse network segments that are not multicast capable. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 precedence $precedence = $rr->precedence; $rr->precedence( $precedence ); 8-bit integer which indicates relative precedence within the RRset. Relays listed in AMTRELAY records with lower precedence are to be attempted first. =head2 Dbit, Discovery Optional $Dbit = $rr->Dbit; $rr->Dbit(1); Boolean field which indicates that the gateway MAY send an AMT Request message directly to the discovered relay address without first sending an AMT Discovery message. =head2 relaytype $relaytype = $rr->relaytype; The relaytype type field indicates the format of the information that is stored in the relay field. The following values are defined: =over 4 0: The relay field is empty (0 bytes). 1: The relay field contains a 4-octet IPv4 address. 2: The relay field contains a 16-octet IPv6 address. 3: The relay field contains a wire-encoded domain name. =back =head2 relay $relay = $rr->relay; $rr->relay( $relay ); The relay field is the address or domain name of the AMT relay. It is formatted according to the relaytype field. =head1 COPYRIGHT Copyright (c)2020 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8777, RFC7450 =cut PK ! Q��Z MR.pmnu �[��� package Net::DNS::RR::MR; use strict; use warnings; our $VERSION = (qw$Id: MR.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MR - DNS MR resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{newname} = Net::DNS::DomainName1035->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $newname = $self->{newname} || return ''; return $newname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $newname = $self->{newname} || return ''; return $newname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->newname(shift); return; } sub newname { my $self = shift; $self->{newname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{newname} ? $self->{newname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR('name MR newname'); =head1 DESCRIPTION Class for DNS Mail Rename (MR) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 newname $newname = $rr->newname; $rr->newname( $newname ); A domain name which specifies a mailbox which is the proper rename of the specified mailbox. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.8 =cut PK ! ]/�!4 4 X25.pmnu �[��� package Net::DNS::RR::X25; use strict; use warnings; our $VERSION = (qw$Id: X25.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::X25 - DNS X25 resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = Net::DNS::Text->decode( $data, $offset ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return $self->{address}->encode; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return $self->{address}->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); return; } sub address { my $self = shift; $self->{address} = Net::DNS::Text->new(shift) if scalar @_; return $self->{address} ? $self->{address}->value : undef; } sub PSDNaddress { return &address; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name X25 PSDNaddress'); =head1 DESCRIPTION Class for DNS X25 resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 PSDNaddress =head2 address $address = $rr->address; $rr->address( $address ); The PSDN-address is a string of decimal digits, beginning with the 4 digit DNIC (Data Network Identification Code), as specified in X.121. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 3.1 =cut PK ! �X�~ L64.pmnu �[��� package Net::DNS::RR::L64; use strict; use warnings; our $VERSION = (qw$Id: L64.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::L64 - DNS L64 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(preference locator64)} = unpack "\@$offset n a8", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'n a8', $self->{preference}, $self->{locator64}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return join ' ', $self->preference, $self->locator64; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->locator64(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub locator64 { my $self = shift; my $prfx = shift; $self->{locator64} = pack 'n4', map { hex($_) } split /:/, $prfx if defined $prfx; return $self->{locator64} ? sprintf( '%x:%x:%x:%x', unpack 'n4', $self->{locator64} ) : undef; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN L64 preference locator64'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'L64', preference => 10, locator64 => '2001:0DB8:1140:1000' ); =head1 DESCRIPTION Class for DNS 64-bit Locator (L64) resource records. The L64 resource record is used to hold 64-bit Locator values for ILNPv6-capable nodes. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this L64 record among other L64 records associated with this owner name. Lower values are preferred over higher values. =head2 locator64 $locator64 = $rr->locator64; The Locator64 field is an unsigned 64-bit integer in network byte order that has the same syntax and semantics as a 64-bit IPv6 routing prefix. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742 =cut PK ! ch�S� � L32.pmnu �[��� package Net::DNS::RR::L32; use strict; use warnings; our $VERSION = (qw$Id: L32.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::L32 - DNS L32 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(preference locator32)} = unpack "\@$offset n a4", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'n a4', $self->{preference}, $self->{locator32}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return join ' ', $self->preference, $self->locator32; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->locator32(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub locator32 { my $self = shift; my $prfx = shift; $self->{locator32} = pack 'C* @4', split /\./, $prfx if defined $prfx; return $self->{locator32} ? join( '.', unpack 'C4', $self->{locator32} ) : undef; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN L32 preference locator32'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'L32', preference => 10, locator32 => '10.1.02.0' ); =head1 DESCRIPTION Class for DNS 32-bit Locator (L32) resource records. The L32 resource record is used to hold 32-bit Locator values for ILNPv4-capable nodes. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this L32 record among other L32 records associated with this owner name. Lower values are preferred over higher values. =head2 locator32 $locator32 = $rr->locator32; The Locator32 field is an unsigned 32-bit integer in network byte order that has the same syntax and semantics as a 32-bit IPv4 routing prefix. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742 =cut PK ! yO�� � RT.pmnu �[��� package Net::DNS::RR::RT; use strict; use warnings; our $VERSION = (qw$Id: RT.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::RT - DNS RT resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{intermediate} = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; return pack 'n a*', $self->preference, $self->{intermediate}->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return join ' ', $self->preference, $self->{intermediate}->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->intermediate(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub intermediate { my $self = shift; $self->{intermediate} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{intermediate} ? $self->{intermediate}->name : undef; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name RT preference intermediate'); =head1 DESCRIPTION Class for DNS Route Through (RT) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer representing the preference of the route. Smaller numbers indicate more preferred routes. =head2 intermediate $intermediate = $rr->intermediate; $rr->intermediate( $intermediate ); The domain name of a host which will serve as an intermediate in reaching the host specified by the owner name. The DNS RRs associated with the intermediate host are expected to include at least one A, X25, or ISDN record. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 3.3 =cut PK ! �V V SIG.pmnu �[��� # pre-5.14.0 perl inadvertently destroys signal handlers # http://rt.perl.org/rt3/Public/Bug/Display.html?id=76138 use strict; use warnings; local %SIG = %SIG; package Net::DNS::RR::SIG; use strict; use warnings; our $VERSION = (qw$Id: SIG.pm 1856 2021-12-02 14:36:25Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SIG - DNS SIG resource record =cut use integer; use Carp; use Time::Local; use Net::DNS::Parameters qw(:type); use constant DEBUG => 0; use constant UTIL => defined eval { require Scalar::Util; }; eval { require MIME::Base64 }; # IMPORTANT: Downstream distros MUST NOT create dependencies on Net::DNS::SEC (strong crypto prohibited in many territories) use constant USESEC => defined $INC{'Net/DNS/SEC.pm'}; # Discover how we got here, without exposing any crypto use constant # Discourage static code analysers and casual greppers DNSSEC => USESEC && defined eval join '', qw(r e q u i r e), ' Net::DNS', qw(:: SEC :: Private); ## no critic my @index; if (DNSSEC) { foreach my $class ( map {"Net::DNS::SEC::$_"} qw(RSA DSA ECCGOST ECDSA EdDSA) ) { my @algorithms = eval join '', qw(r e q u i r e), " $class; $class->_index"; ## no critic push @index, map { ( $_ => $class ) } @algorithms; } croak 'Net::DNS::SEC version not supported' unless scalar(@index); } my %DNSSEC_verify = @index; my %DNSSEC_siggen = @index; my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{@field} = unpack "\@$offset n C2 N3 n", $$data; ( $self->{signame}, $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 18 ); $self->{sigbin} = substr $$data, $offset, $limit - $offset; croak('misplaced or corrupt SIG') unless $limit == length $$data; my $raw = substr $$data, 0, $self->{offset}; $self->{rawref} = \$raw; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my ( $hash, $packet ) = @opaque; my $signame = $self->{signame}; if ( DNSSEC && !$self->{sigbin} ) { my $private = delete $self->{private}; # one shot is all you get my $sigdata = $self->_CreateSigData($packet); $self->_CreateSig( $sigdata, $private || die 'missing key reference' ); } return pack 'n C2 N3 n a* a*', @{$self}{@field}, $signame->encode, $self->sigbin; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $sname = $self->{signame} || return ''; my @sig64 = split /\s+/, MIME::Base64::encode( $self->sigbin ); my @rdata = ( map( { $self->$_ } @field ), $sname->string, @sig64 ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach ( @field, qw(signame) ) { $self->$_(shift) } $self->signature(@_); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->class('ANY'); $self->typecovered('TYPE0'); $self->algorithm(1); $self->labels(0); $self->orgttl(0); $self->sigval(10); return; } sub typecovered { my $self = shift; # uncoverable pod $self->{typecovered} = typebyname(shift) if scalar @_; my $typecode = $self->{typecovered}; return defined $typecode ? typebyval($typecode) : undef; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _algbyname($arg); } sub labels { return shift->{labels} = 0; # uncoverable pod } sub orgttl { return shift->{orgttl} = 0; # uncoverable pod } sub sigexpiration { my $self = shift; $self->{sigexpiration} = _string2time(shift) if scalar @_; my $time = $self->{sigexpiration}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub siginception { my $self = shift; $self->{siginception} = _string2time(shift) if scalar @_; my $time = $self->{siginception}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub sigex { return &sigexpiration; } ## historical sub sigin { return &siginception; } ## historical sub sigval { my $self = shift; no integer; ( $self->{sigval} ) = map { int( 60.0 * $_ ) } @_; return; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; return $self->{keytag} || 0; } sub signame { my $self = shift; $self->{signame} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{signame} ? $self->{signame}->name : undef; } sub sig { my $self = shift; return MIME::Base64::encode( $self->sigbin(), "" ) unless scalar @_; return $self->sigbin( MIME::Base64::decode( join "", @_ ) ); } sub sigbin { my $self = shift; $self->{sigbin} = shift if scalar @_; return $self->{sigbin} || ""; } sub signature { return &sig; } sub create { unless (DNSSEC) { croak qq[No "use Net::DNS::SEC" declaration in application code]; } else { my ( $class, $data, $priv_key, %etc ) = @_; my $private = ref($priv_key) ? $priv_key : ( Net::DNS::SEC::Private->new($priv_key) ); croak 'Unable to parse private key' unless ref($private) eq 'Net::DNS::SEC::Private'; my $self = Net::DNS::RR->new( type => 'SIG', typecovered => 'TYPE0', siginception => time(), algorithm => $private->algorithm, keytag => $private->keytag, signame => $private->signame, ); while ( my ( $attribute, $value ) = each %etc ) { $self->$attribute($value); } $self->{sigexpiration} = $self->{siginception} + $self->{sigval} unless $self->{sigexpiration}; $self->_CreateSig( $self->_CreateSigData($data), $private ) if $data; $self->{private} = $private unless $data; # mark packet for SIG0 generation return $self; } } sub verify { # Reminder... # $dataref may be either a data string or a reference to a # Net::DNS::Packet object. # # $keyref is either a key object or a reference to an array # of keys. unless (DNSSEC) { croak qq[No "use Net::DNS::SEC" declaration in application code]; } else { my ( $self, $dataref, $keyref ) = @_; if ( my $isa = ref($dataref) ) { print '$dataref argument is ', $isa, "\n" if DEBUG; croak '$dataref must be scalar or a Net::DNS::Packet' unless $isa =~ /Net::DNS/ && $dataref->isa('Net::DNS::Packet'); } print '$keyref argument is of class ', ref($keyref), "\n" if DEBUG; if ( ref($keyref) eq "ARRAY" ) { # We will iterate over the supplied key list and # return when there is a successful verification. # If not, continue so that we survive key-id collision. print "Iterating over ", scalar(@$keyref), " keys\n" if DEBUG; my @error; foreach my $keyrr (@$keyref) { my $result = $self->verify( $dataref, $keyrr ); return $result if $result; my $error = $self->{vrfyerrstr}; my $keyid = $keyrr->keytag; push @error, "key $keyid: $error"; print "key $keyid: $error\n" if DEBUG; next; } $self->{vrfyerrstr} = join "\n", @error; return 0; } elsif ( $keyref->isa('Net::DNS::RR::DNSKEY') ) { print "Validating using key with keytag: ", $keyref->keytag, "\n" if DEBUG; } else { croak join ' ', ref($keyref), 'can not be used as SIG0 key'; } croak "SIG typecovered is TYPE$self->{typecovered}" if $self->{typecovered}; if (DEBUG) { print "\n ---------------------- SIG DEBUG ----------------------"; print "\n SIG:\t", $self->string; print "\n KEY:\t", $keyref->string; print "\n -------------------------------------------------------\n"; } $self->{vrfyerrstr} = ''; unless ( $self->algorithm == $keyref->algorithm ) { $self->{vrfyerrstr} = 'algorithm does not match'; return 0; } unless ( $self->keytag == $keyref->keytag ) { $self->{vrfyerrstr} = 'keytag does not match'; return 0; } # The data that is to be verified my $sigdata = $self->_CreateSigData($dataref); my $verified = $self->_VerifySig( $sigdata, $keyref ) || return 0; # time to do some time checking. my $t = time; if ( _ordered( $self->{sigexpiration}, $t ) ) { $self->{vrfyerrstr} = join ' ', 'Signature expired at', $self->sigexpiration; return 0; } elsif ( _ordered( $t, $self->{siginception} ) ) { $self->{vrfyerrstr} = join ' ', 'Signature valid from', $self->siginception; return 0; } return 1; } } #END verify sub vrfyerrstr { return shift->{vrfyerrstr}; } ######################################## { my @algbyname = ( 'DELETE' => 0, # [RFC4034][RFC4398][RFC8078] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; foreach (@algbyname) { s/[\W_]//g; } # strip non-alphanumerics my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname; my %algbyname = @algrehash; # work around broken cperl sub _algbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $algbyname{$key}; return $val if defined $val; return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg]; } sub _algbyval { my $value = shift; return $algbyval{$value} || return $value; } } { my %siglen = ( 1 => 128, 3 => 41, 5 => 256, 6 => 41, 7 => 256, 8 => 256, 10 => 256, 12 => 64, 13 => 64, 14 => 96, 15 => 64, 16 => 114, ); sub _size { ## estimate encoded size my $self = shift; my $clone = bless {%$self}, ref($self); # shallow clone $clone->sigbin( 'x' x $siglen{$self->algorithm} ); return length $clone->encode(); } } sub _CreateSigData { if (DNSSEC) { my ( $self, $message ) = @_; if ( ref($message) ) { die 'missing packet reference' unless $message->isa('Net::DNS::Packet'); my @unsigned = grep { ref($_) ne ref($self) } @{$message->{additional}}; local $message->{additional} = \@unsigned; # remake header image my @part = qw(question answer authority additional); my @size = map { scalar @{$message->{$_}} } @part; my $rref = delete $self->{rawref}; my $data = $rref ? $$rref : $message->data; my ( $id, $status ) = unpack 'n2', $data; my $hbin = pack 'n6 a*', $id, $status, @size; $message = $hbin . substr $data, length $hbin; } my $sigdata = pack 'n C2 N3 n a*', @{$self}{@field}, $self->{signame}->encode; print "\npreamble\t", unpack( 'H*', $sigdata ), "\nrawdata\t", unpack( 'H100', $message ), " ...\n" if DEBUG; return join '', $sigdata, $message; } } sub _CreateSig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $DNSSEC_siggen{$algorithm}; return eval { die "algorithm $algorithm not supported\n" unless $class; $self->sigbin( $class->sign(@_) ); } || return croak "${@}signature generation failed"; } } sub _VerifySig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $DNSSEC_verify{$algorithm}; my $retval = eval { die "algorithm $algorithm not supported\n" unless $class; $class->verify( @_, $self->sigbin ); }; unless ($retval) { $self->{vrfyerrstr} = "${@}signature verification failed"; print "\n", $self->{vrfyerrstr}, "\n" if DEBUG; return 0; } # uncoverable branch true # bug in Net::DNS::SEC or dependencies croak "unknown error in $class->verify" unless $retval == 1; print "\nalgorithm $algorithm verification successful\n" if DEBUG; return 1; } } sub _ordered() { ## irreflexive 32-bit partial ordering use integer; my ( $n1, $n2 ) = @_; return 0 unless defined $n2; # ( any, undef ) return 1 unless defined $n1; # ( undef, any ) # unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished if ( $n2 < 0 ) { # fold, leaving $n2 non-negative $n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000; # -2**31 <= $n1 < 2**32 $n2 = ( $n2 & 0x7FFFFFFF ); # 0 <= $n2 < 2**31 } return $n1 < $n2 ? ( $n1 > ( $n2 - 0x80000000 ) ) : ( $n2 < ( $n1 - 0x80000000 ) ); } my $y1998 = timegm( 0, 0, 0, 1, 0, 1998 ); my $y2026 = timegm( 0, 0, 0, 1, 0, 2026 ); my $y2082 = $y2026 << 1; my $y2054 = $y2082 - $y1998; my $m2026 = int( 0x80000000 - $y2026 ); my $m2054 = int( 0x80000000 - $y2054 ); my $t2082 = int( $y2082 & 0x7FFFFFFF ); my $t2100 = 1960058752; sub _string2time { ## parse time specification string my $arg = shift; return int($arg) if length($arg) < 12; my ( $y, $m, @dhms ) = unpack 'a4 a2 a2 a2 a2 a2', $arg . '00'; if ( $arg lt '20380119031408' ) { # calendar folding return timegm( reverse(@dhms), $m - 1, $y ) if $y < 2026; return timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2026; } elsif ( $y > 2082 ) { my $z = timegm( reverse(@dhms), $m - 1, $y - 84 ); # expunge 29 Feb 2100 return $z < 1456790400 ? $z + $y2054 : $z + $y2054 - 86400; } return ( timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2054 ) - $y1998; } sub _time2string { ## format time specification string my $arg = shift; my $ls31 = int( $arg & 0x7FFFFFFF ); if ( $arg & 0x80000000 ) { if ( $ls31 > $t2082 ) { $ls31 += 86400 unless $ls31 < $t2100; # expunge 29 Feb 2100 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2054 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1984, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } elsif ( $ls31 > $y2026 ) { my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 - $y2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime $ls31 )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1900, $mm + 1, @dhms; } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name SIG typecovered algorithm labels orgttl sigexpiration siginception keytag signame signature'); use Net::DNS::SEC; $sigrr = Net::DNS::RR::SIG->create( $string, $keypath, sigval => 10 # minutes ); $sigrr->verify( $string, $keyrr ) || die $sigrr->vrfyerrstr; $sigrr->verify( $packet, $keyrr ) || die $sigrr->vrfyerrstr; =head1 DESCRIPTION Class for DNS digital signature (SIG) resource records. In addition to the regular methods inherited from Net::DNS::RR the class contains a method to sign packets and scalar data strings using private keys (create) and a method for verifying signatures. The SIG RR is an implementation of RFC2931. See L<Net::DNS::RR::RRSIG> for an implementation of RFC4034. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; The algorithm number field identifies the cryptographic algorithm used to create the signature. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 sigexpiration and siginception times =head2 sigex sigin sigval $expiration = $rr->sigexpiration; $expiration = $rr->sigexpiration( $value ); $inception = $rr->siginception; $inception = $rr->siginception( $value ); The signature expiration and inception fields specify a validity time interval for the signature. The value may be specified by a string with format 'yyyymmddhhmmss' or a Perl time() value. Return values are dual-valued, providing either a string value or numerical Perl time() value. =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); The keytag field contains the key tag value of the KEY RR that validates this signature. =head2 signame $signame = $rr->signame; $rr->signame( $signame ); The signer name field value identifies the owner name of the KEY RR that a validator is supposed to use to validate this signature. =head2 signature =head2 sig $sig = $rr->sig; $rr->sig( $sig ); The Signature field contains the cryptographic signature that covers the SIG RDATA (excluding the Signature field) and the subject data. =head2 sigbin $sigbin = $rr->sigbin; $rr->sigbin( $sigbin ); Binary representation of the cryptographic signature. =head2 create Create a signature over scalar data. use Net::DNS::SEC; $keypath = '/home/olaf/keys/Kbla.foo.+001+60114.private'; $sigrr = Net::DNS::RR::SIG->create( $data, $keypath ); $sigrr = Net::DNS::RR::SIG->create( $data, $keypath, sigval => 10 ); $sigrr->print; # Alternatively use Net::DNS::SEC::Private $private = Net::DNS::SEC::Private->new($keypath); $sigrr= Net::DNS::RR::SIG->create( $data, $private ); create() is an alternative constructor for a SIG RR object. This method returns a SIG with the signature over the data made with the private key stored in the key file. The first argument is a scalar that contains the data to be signed. The second argument is a string which specifies the path to a file containing the private key as generated using dnssec-keygen, a program that comes with the ISC BIND distribution. The optional remaining arguments consist of ( name => value ) pairs as follows: sigin => 20211201010101, # signature inception sigex => 20211201011101, # signature expiration sigval => 10, # validity window (minutes) The sigin and sigex values may be specified as Perl time values or as a string with the format 'yyyymmddhhmmss'. The default for sigin is the time of signing. The sigval argument specifies the signature validity window in minutes ( sigex = sigin + sigval ). By default the signature is valid for 10 minutes. =over 4 =item * Do not change the name of the private key file. The create method uses the filename as generated by dnssec-keygen to determine the keyowner, algorithm, and the keyid (keytag). =back =head2 verify $verify = $sigrr->verify( $data, $keyrr ); $verify = $sigrr->verify( $data, [$keyrr, $keyrr2, $keyrr3] ); The verify() method performs SIG0 verification of the specified data against the signature contained in the $sigrr object itself using the public key in $keyrr. 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 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. Returns false on error and sets $sig->vrfyerrstr =head2 vrfyerrstr $sig0 = $packet->sigrr || die 'not signed'; print $sig0->vrfyerrstr unless $sig0->verify( $packet, $keyrr ); $sigrr->verify( $packet, $keyrr ) || die $sigrr->vrfyerrstr; =head1 REMARKS The code is not optimised for speed. If this code is still around in 2100 (not a leap year) you will need to check for proper handling of times after 28th February. =head1 ACKNOWLEDGMENTS Although their original code may have disappeared following redesign of Net::DNS, Net::DNS::SEC and the OpenSSL API, the following individual contributors deserve to be recognised for their significant influence on the development of the SIG package. Andy Vaskys (Network Associates Laboratories) supplied code for RSA. T.J. Mather provided support for the DSA algorithm. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC, Olaf M. Kolkman Copyright (c)2007-2008 NLnet Labs, Olaf M. Kolkman Portions Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::SEC>, RFC2536, RFC2931, RFC3110, RFC4034 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers> L<BIND Administrator Reference Manual|http://bind.isc.org/> =cut PK ! ��� HINFO.pmnu �[��� package Net::DNS::RR::HINFO; use strict; use warnings; our $VERSION = (qw$Id: HINFO.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::HINFO - DNS HINFO resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; ( $self->{cpu}, $offset ) = Net::DNS::Text->decode( $data, $offset ); ( $self->{os}, $offset ) = Net::DNS::Text->decode( $data, $offset ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return join '', $self->{cpu}->encode, $self->{os}->encode; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return join ' ', $self->{cpu}->string, $self->{os}->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->cpu(shift); $self->os(@_); return; } sub cpu { my $self = shift; $self->{cpu} = Net::DNS::Text->new(shift) if scalar @_; return $self->{cpu} ? $self->{cpu}->value : undef; } sub os { my $self = shift; $self->{os} = Net::DNS::Text->new(shift) if scalar @_; return $self->{os} ? $self->{os}->value : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name HINFO cpu os'); =head1 DESCRIPTION Class for DNS Hardware Information (HINFO) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 cpu $cpu = $rr->cpu; $rr->cpu( $cpu ); Returns the CPU type for this RR. =head2 os $os = $rr->os; $rr->os( $os ); Returns the operating system type for this RR. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.2 =cut PK ! �y�+k k ZONEMD.pmnu �[��� package Net::DNS::RR::ZONEMD; use strict; use warnings; our $VERSION = (qw$Id: ZONEMD.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::ZONEMD - DNS ZONEMD resource record =cut use integer; use Carp; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $rdata = substr $$data, $offset, $self->{rdlength}; @{$self}{qw(serial scheme algorithm digestbin)} = unpack 'NC2a*', $rdata; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'NC2a*', @{$self}{qw(serial scheme algorithm digestbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @digest = split /(\S{64})/, $self->digest || qq(""); my @rdata = ( @{$self}{qw(serial scheme algorithm)}, @digest ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->serial(shift); $self->scheme(shift); $self->algorithm(shift); $self->digest(@_); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata( 0, 1, 1, '' ); return; } sub serial { my $self = shift; $self->{serial} = 0 + shift if scalar @_; return $self->{serial} || 0; } sub scheme { my $self = shift; $self->{scheme} = 0 + shift if scalar @_; return $self->{scheme} || 0; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; return $self->{algorithm} || 0; } sub digest { my $self = shift; return unpack "H*", $self->digestbin() unless scalar @_; return $self->digestbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub digestbin { my $self = shift; $self->{digestbin} = shift if scalar @_; return $self->{digestbin} || ""; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new("example.com. ZONEMD 2018031500 1 1 FEBE3D4CE2EC2FFA4BA99D46CD69D6D29711E55217057BEE 7EB1A7B641A47BA7FED2DD5B97AE499FAFA4F22C6BD647DE"); =head1 DESCRIPTION Class for DNS Zone Message Digest (ZONEMD) resource record. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 serial $serial = $rr->serial; $rr->serial( $serial ); Unsigned 32-bit integer zone serial number. =head2 scheme $scheme = $rr->scheme; $rr->scheme( $scheme ); The scheme field is an 8-bit unsigned integer that identifies the methods by which data is collated and presented as input to the hashing function. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The algorithm field is an 8-bit unsigned integer that identifies the cryptographic hash algorithm used to construct the digest. =head2 digest $digest = $rr->digest; $rr->digest( $digest ); Hexadecimal representation of the digest over the zone content. =head2 digestbin $digestbin = $rr->digestbin; $rr->digestbin( $digestbin ); Binary representation of the digest over the zone content. =head1 COPYRIGHT Copyright (c)2019 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8976 =cut PK ! ���{ { NID.pmnu �[��� package Net::DNS::RR::NID; use strict; use warnings; our $VERSION = (qw$Id: NID.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NID - DNS NID resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(preference nodeid)} = unpack "\@$offset n a8", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'n a8', $self->{preference}, $self->{nodeid}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return join ' ', $self->preference, $self->nodeid; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->nodeid(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub nodeid { my $self = shift; my $idnt = shift; $self->{nodeid} = pack 'n4', map { hex($_) } split /:/, $idnt if defined $idnt; return $self->{nodeid} ? sprintf( '%0.4x:%0.4x:%0.4x:%0.4x', unpack 'n4', $self->{nodeid} ) : undef; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN NID preference nodeid'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'NID', preference => 10, nodeid => '8:800:200C:417A' ); =head1 DESCRIPTION Class for DNS Node Identifier (NID) resource records. The Node Identifier (NID) DNS resource record is used to hold values for Node Identifiers that will be used for ILNP-capable nodes. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this NID record among other NID records associated with this owner name. Lower values are preferred over higher values. =head2 nodeid $nodeid = $rr->nodeid; The NodeID field is an unsigned 64-bit value in network byte order. The text representation uses the same syntax (i.e., groups of 4 hexadecimal digits separated by a colons) that is already used for IPv6 interface identifiers. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742 =cut PK ! iA�b� � SMIMEA.pmnu �[��� package Net::DNS::RR::SMIMEA; use strict; use warnings; our $VERSION = (qw$Id: SMIMEA.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SMIMEA - DNS SMIMEA resource record =cut use integer; use Carp; use constant BABBLE => defined eval { require Digest::BubbleBabble }; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $next = $offset + $self->{rdlength}; @{$self}{qw(usage selector matchingtype)} = unpack "\@$offset C3", $$data; $offset += 3; $self->{certbin} = substr $$data, $offset, $next - $offset; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'C3 a*', @{$self}{qw(usage selector matchingtype certbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; $self->_annotation( $self->babble ) if BABBLE; my @cert = split /(\S{64})/, $self->cert; my @rdata = ( $self->usage, $self->selector, $self->matchingtype, @cert ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->usage(shift); $self->selector(shift); $self->matchingtype(shift); $self->cert(@_); return; } sub usage { my $self = shift; $self->{usage} = 0 + shift if scalar @_; return $self->{usage} || 0; } sub selector { my $self = shift; $self->{selector} = 0 + shift if scalar @_; return $self->{selector} || 0; } sub matchingtype { my $self = shift; $self->{matchingtype} = 0 + shift if scalar @_; return $self->{matchingtype} || 0; } sub cert { my $self = shift; return unpack "H*", $self->certbin() unless scalar @_; return $self->certbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub certbin { my $self = shift; $self->{certbin} = shift if scalar @_; return $self->{certbin} || ""; } sub certificate { return &cert; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->certbin ) : ''; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name SMIMEA usage selector matchingtype certificate'); =head1 DESCRIPTION The SMIMEA DNS resource record (RR) is used to associate an end entity certificate or public key with the associated email address, thus forming a "SMIMEA certificate association". The semantics of how the SMIMEA RR is interpreted are described in RFC6698. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 usage $usage = $rr->usage; $rr->usage( $usage ); 8-bit integer value which specifies the provided association that will be used to match the certificate. =head2 selector $selector = $rr->selector; $rr->selector( $selector ); 8-bit integer value which specifies which part of the certificate presented by the server will be matched against the association data. =head2 matchingtype $matchingtype = $rr->matchingtype; $rr->matchingtype( $matchingtype ); 8-bit integer value which specifies how the certificate association is presented. =head2 certificate =head2 cert $cert = $rr->cert; $rr->cert( $cert ); Hexadecimal representation of the certificate data. =head2 certbin $certbin = $rr->certbin; $rr->certbin( $certbin ); Binary representation of the certificate data. =head2 babble print $rr->babble; The babble() method returns the 'BubbleBabble' representation of the digest if the Digest::BubbleBabble package is available, otherwise an empty string is returned. BubbleBabble represents a message digest as a string of plausible words, to make the digest easier to verify. The "words" are not necessarily real words, but they look more like words than a string of hex characters. The 'BubbleBabble' string is appended as a comment when the string method is called. =head1 COPYRIGHT Copyright (c)2016 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8162, RFC6698 =cut PK ! ��Q� LP.pmnu �[��� package Net::DNS::RR::LP; use strict; use warnings; our $VERSION = (qw$Id: LP.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::LP - DNS LP resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{target} = Net::DNS::DomainName->decode( $data, $offset + 2 ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $target = $self->{target}; return pack 'n a*', $self->preference, $target->encode(); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target}; return join ' ', $self->preference, $target->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->target(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub target { my $self = shift; $self->{target} = Net::DNS::DomainName->new(shift) if scalar @_; return $self->{target} ? $self->{target}->name : undef; } sub FQDN { return shift->{target}->fqdn; } sub fqdn { return shift->{target}->fqdn; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN LP preference FQDN'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'LP', preference => 10, target => 'target.example.com.' ); =head1 DESCRIPTION Class for DNS Locator Pointer (LP) resource records. The LP DNS resource record (RR) is used to hold the name of a subnetwork for ILNP. The name is an FQDN which can then be used to look up L32 or L64 records. LP is, effectively, a Locator Pointer to L32 and/or L64 records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit unsigned integer in network byte order that indicates the relative preference for this LP record among other LP records associated with this owner name. Lower values are preferred over higher values. =head2 FQDN, fqdn =head2 target $target = $rr->target; $rr->target( $target ); The FQDN field contains the DNS target name that is used to reference L32 and/or L64 records. =head1 COPYRIGHT Copyright (c)2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6742 =cut PK ! ;�x5� � IPSECKEY.pmnu �[��� package Net::DNS::RR::IPSECKEY; use strict; use warnings; our $VERSION = (qw$Id: IPSECKEY.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::IPSECKEY - DNS IPSECKEY resource record =cut use integer; use Carp; use MIME::Base64; use Net::DNS::DomainName; use Net::DNS::RR::A; use Net::DNS::RR::AAAA; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{qw(precedence gatetype algorithm)} = unpack "\@$offset C3", $$data; $offset += 3; my $gatetype = $self->{gatetype}; if ( not $gatetype ) { $self->{gateway} = undef; # no gateway } elsif ( $gatetype == 1 ) { $self->{gateway} = unpack "\@$offset a4", $$data; $offset += 4; } elsif ( $gatetype == 2 ) { $self->{gateway} = unpack "\@$offset a16", $$data; $offset += 16; } elsif ( $gatetype == 3 ) { my $name; ( $name, $offset ) = Net::DNS::DomainName->decode( $data, $offset ); $self->{gateway} = $name; } else { die "unknown gateway type ($gatetype)"; } $self->keybin( substr $$data, $offset, $limit - $offset ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $gatetype = $self->gatetype; my $gateway = $self->{gateway}; my $precedence = $self->precedence; my $algorithm = $self->algorithm; my $keybin = $self->keybin; if ( not $gatetype ) { return pack 'C3 a*', $precedence, $gatetype, $algorithm, $keybin; } elsif ( $gatetype == 1 ) { return pack 'C3 a4 a*', $precedence, $gatetype, $algorithm, $gateway, $keybin; } elsif ( $gatetype == 2 ) { return pack 'C3 a16 a*', $precedence, $gatetype, $algorithm, $gateway, $keybin; } elsif ( $gatetype == 3 ) { my $namebin = $gateway->encode; return pack 'C3 a* a*', $precedence, $gatetype, $algorithm, $namebin, $keybin; } die "unknown gateway type ($gatetype)"; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @params = map { $self->$_ } qw(precedence gatetype algorithm); my @base64 = split /\s+/, encode_base64( $self->keybin ); my @rdata = ( @params, $self->gateway, @base64 ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(precedence gatetype algorithm gateway)) { $self->$_(shift) } $self->key(@_); return; } sub precedence { my $self = shift; $self->{precedence} = 0 + shift if scalar @_; return $self->{precedence} || 0; } sub gatetype { return shift->{gatetype} || 0; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; return $self->{algorithm} || 0; } sub gateway { my $self = shift; for (@_) { /^\.*$/ && do { $self->{gatetype} = 0; $self->{gateway} = undef; # no gateway last; }; /:.*:/ && do { $self->{gatetype} = 2; $self->{gateway} = Net::DNS::RR::AAAA::address( {}, $_ ); last; }; /\.\d+$/ && do { $self->{gatetype} = 1; $self->{gateway} = Net::DNS::RR::A::address( {}, $_ ); last; }; /\..+/ && do { $self->{gatetype} = 3; $self->{gateway} = Net::DNS::DomainName->new($_); last; }; croak 'unrecognised gateway type'; } if ( defined wantarray ) { my $gatetype = $self->{gatetype}; return wantarray ? '.' : undef unless $gatetype; my $gateway = $self->{gateway}; for ($gatetype) { /^1$/ && return Net::DNS::RR::A::address( {address => $gateway} ); /^2$/ && return Net::DNS::RR::AAAA::address( {address => $gateway} ); /^3$/ && return wantarray ? $gateway->string : $gateway->name; die "unknown gateway type ($gatetype)"; } } return; } sub key { my $self = shift; return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_; return $self->keybin( MIME::Base64::decode( join "", @_ ) ); } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; return $self->{keybin} || ""; } sub pubkey { return &key; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IPSECKEY precedence gatetype algorithm gateway key'); =head1 DESCRIPTION DNS IPSEC Key Storage (IPSECKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 precedence $precedence = $rr->precedence; $rr->precedence( $precedence ); This is an 8-bit precedence for this record. Gateways listed in IPSECKEY records with lower precedence are to be attempted first. =head2 gatetype $gatetype = $rr->gatetype; The gateway type field indicates the format of the information that is stored in the gateway field. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The algorithm type field identifies the public keys cryptographic algorithm and determines the format of the public key field. =head2 gateway $gateway = $rr->gateway; $rr->gateway( $gateway ); The gateway field indicates a gateway to which an IPsec tunnel may be created in order to reach the entity named by this resource record. =head2 pubkey =head2 key $key = $rr->key; $rr->key( $key ); Base64 representation of the optional public key block for the resource record. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); Binary representation of the public key block for the resource record. =head1 COPYRIGHT Copyright (c)2007 Olaf Kolkman, NLnet Labs. Portions Copyright (c)2012,2015 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4025 =cut PK ! �G,<) <) DS.pmnu �[��� package Net::DNS::RR::DS; use strict; use warnings; our $VERSION = (qw$Id: DS.pm 1856 2021-12-02 14:36:25Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DS - DNS DS resource record =cut use integer; use Carp; use constant BABBLE => defined eval { require Digest::BubbleBabble }; eval { require Digest::SHA }; ## optional for simple Net::DNS RR eval { require Digest::GOST12 }; eval { require Digest::GOST::CryptoPro }; my %digest = ( '1' => scalar( eval { Digest::SHA->new(1) } ), '2' => scalar( eval { Digest::SHA->new(256) } ), '3' => scalar( eval { Digest::GOST::CryptoPro->new() } ), '4' => scalar( eval { Digest::SHA->new(384) } ), '5' => scalar( eval { Digest::GOST12->new() } ), ); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $rdata = substr $$data, $offset, $self->{rdlength}; @{$self}{qw(keytag algorithm digtype digestbin)} = unpack 'n C2 a*', $rdata; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'n C2 a*', @{$self}{qw(keytag algorithm digtype digestbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; $self->_annotation( $self->babble ) if BABBLE && $self->{algorithm}; my @param = @{$self}{qw(keytag algorithm digtype)}; my @rdata = ( @param, split /(\S{64})/, $self->digest || '-' ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my $keytag = shift; ## avoid destruction by CDS algorithm(0) $self->algorithm(shift); $self->keytag($keytag); $self->digtype(shift); $self->digest(@_); return; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; return $self->{keytag} || 0; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if uc($arg) eq 'MNEMONIC'; return $self->{algorithm} = _algbyname($arg) || die _algbyname('') # disallow algorithm(0) } sub digtype { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _digestbyname($argn) : _digestbyval($argn); } return $self->{digtype} unless defined $arg; return _digestbyval( $self->{digtype} ) if uc($arg) eq 'MNEMONIC'; return $self->{digtype} = _digestbyname($arg) || die _digestbyname('') # disallow digtype(0) } sub digest { my $self = shift; return unpack "H*", $self->digestbin() unless scalar @_; return $self->digestbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub digestbin { my $self = shift; $self->{digestbin} = shift if scalar @_; return $self->{digestbin} || ""; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->digestbin ) : ''; } sub create { my $class = shift; my $keyrr = shift; my %args = @_; my ($type) = reverse split '::', $class; croak "Unable to create $type record for non-zone key" unless $keyrr->zone; croak "Unable to create $type record for revoked key" if $keyrr->revoke; croak "Unable to create $type record for invalid key" unless $keyrr->protocol == 3; my $self = Net::DNS::RR->new( owner => $keyrr->owner, # per definition, same as keyrr type => $type, class => $keyrr->class, ttl => $keyrr->{ttl}, keytag => $keyrr->keytag, algorithm => $keyrr->algorithm, digtype => 1, # SHA1 by default %args ); my $hash = $digest{$self->digtype}; croak join ' ', 'digtype', $self->digtype('MNEMONIC'), 'not supported' unless $hash; my $clone = $hash->clone; $clone->add( $keyrr->{owner}->canonical ); $clone->add( $keyrr->_encode_rdata ); $self->digestbin( $clone->digest ); return $self; } sub verify { my ( $self, $key ) = @_; my $verify = Net::DNS::RR::DS->create( $key, ( digtype => $self->digtype ) ); return $verify->digestbin eq $self->digestbin; } ######################################## { my @digestbyname = ( 'SHA-1' => 1, # [RFC3658] 'SHA-256' => 2, # [RFC4509] 'GOST-R-34.11-94' => 3, # [RFC5933] 'SHA-384' => 4, # [RFC6605] 'GOST-R-34.11-2012' => 5, # [RFC5933bis] ); my @digestalias = ( 'SHA' => 1, 'GOST94' => 3, 'GOST12' => 5, ); my %digestbyval = reverse @digestbyname; foreach (@digestbyname) { s/[\W_]//g; } # strip non-alphanumerics my @digestrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @digestbyname; my %digestbyname = ( @digestalias, @digestrehash ); # work around broken cperl sub _digestbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $digestbyname{$key}; return $val if defined $val; return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg]; } sub _digestbyval { my $value = shift; return $digestbyval{$value} || return $value; } } { my @algbyname = ( 'DELETE' => 0, # [RFC4034][RFC4398][RFC8078] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; foreach (@algbyname) { s/[\W_]//g; } # strip non-alphanumerics my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname; my %algbyname = @algrehash; # work around broken cperl sub _algbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $algbyname{$key}; return $val if defined $val; return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg]; } sub _algbyval { my $value = shift; return $algbyval{$value} || return $value; } } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name DS keytag algorithm digtype digest'); use Net::DNS::SEC; $ds = Net::DNS::RR::DS->create( $dnskeyrr, digtype => 'SHA256', ttl => 3600 ); =head1 DESCRIPTION Class for DNS Delegation Signer (DS) resource record. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); The 16-bit numerical key tag of the key. (RFC2535 4.1.6) =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); Decimal representation of the 8-bit algorithm field. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 digtype $digtype = $rr->digtype; $rr->digtype( $digtype ); Decimal representation of the 8-bit digest type field. digtype() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 digest $digest = $rr->digest; $rr->digest( $digest ); Hexadecimal representation of the digest over the label and key. =head2 digestbin $digestbin = $rr->digestbin; $rr->digestbin( $digestbin ); Binary representation of the digest over the label and key. =head2 babble print $rr->babble; The babble() method returns the 'BubbleBabble' representation of the digest if the Digest::BubbleBabble package is available, otherwise an empty string is returned. BubbleBabble represents a message digest as a string of plausible words, to make the digest easier to verify. The "words" are not necessarily real words, but they look more like words than a string of hex characters. The 'BubbleBabble' string is appended as a comment when the string method is called. =head2 create use Net::DNS::SEC; $dsrr = Net::DNS::RR::DS->create( $keyrr, digtype => 'SHA-256' ); $keyrr->print; $dsrr->print; This constructor takes a DNSKEY argument and will return the corresponding DS RR constructed using the specified algorithm. The digest algorithm defaults to SHA-1. =head2 verify $verify = $dsrr->verify($keyrr); The boolean verify method will return true if the hash over the key RR provided as the argument conforms to the data in the DS itself i.e. the DS points to the DNSKEY from the argument. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC. Author Olaf M. Kolkman Portions Copyright (c)2013,2021 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4034 L<Digest Types|http://www.iana.org/assignments/ds-rr-types> L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers> =cut PK ! ���o o MINFO.pmnu �[��� package Net::DNS::RR::MINFO; use strict; use warnings; our $VERSION = (qw$Id: MINFO.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MINFO - DNS MINFO resource record =cut use integer; use Net::DNS::Mailbox; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; ( $self->{rmailbx}, $offset ) = Net::DNS::Mailbox1035->decode(@_); ( $self->{emailbx}, $offset ) = Net::DNS::Mailbox1035->decode( $data, $offset, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $rdata = $self->{rmailbx}->encode(@_); $rdata .= $self->{emailbx}->encode( $offset + length $rdata, @opaque ); return $rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = ( $self->{rmailbx}->string, $self->{emailbx}->string ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->rmailbx(shift); $self->emailbx(shift); return; } sub rmailbx { my $self = shift; $self->{rmailbx} = Net::DNS::Mailbox1035->new(shift) if scalar @_; return $self->{rmailbx} ? $self->{rmailbx}->address : undef; } sub emailbx { my $self = shift; $self->{emailbx} = Net::DNS::Mailbox1035->new(shift) if scalar @_; return $self->{emailbx} ? $self->{emailbx}->address : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR('name MINFO rmailbx emailbx'); =head1 DESCRIPTION Class for DNS Mailbox Information (MINFO) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 rmailbx $rmailbx = $rr->rmailbx; $rr->rmailbx( $rmailbx ); A domain name which specifies a mailbox which is responsible for the mailing list or mailbox. If this domain name names the root, the owner of the MINFO RR is responsible for itself. Note that many existing mailing lists use a mailbox X-request to identify the maintainer of mailing list X, e.g., Msgroup-request for Msgroup. This field provides a more general mechanism. =head2 emailbx $emailbx = $rr->emailbx; $rr->emailbx( $emailbx ); A domain name which specifies a mailbox which is to receive error messages related to the mailing list or mailbox specified by the owner of the MINFO RR (similar to the ERRORS-TO: field which has been proposed). If this domain name names the root, errors should be returned to the sender of the message. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.7 =cut PK ! <j�4� � SSHFP.pmnu �[��� package Net::DNS::RR::SSHFP; use strict; use warnings; our $VERSION = (qw$Id: SSHFP.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SSHFP - DNS SSHFP resource record =cut use integer; use Carp; use constant BABBLE => defined eval { require Digest::BubbleBabble }; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = $self->{rdlength} - 2; @{$self}{qw(algorithm fptype fpbin)} = unpack "\@$offset C2 a$size", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'C2 a*', @{$self}{qw(algorithm fptype fpbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; $self->_annotation( $self->babble ) if BABBLE; my @fprint = split /(\S{64})/, $self->fp; my @rdata = ( $self->algorithm, $self->fptype, @fprint ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->algorithm(shift); $self->fptype(shift); $self->fp(@_); return; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; return $self->{algorithm} || 0; } sub fptype { my $self = shift; $self->{fptype} = 0 + shift if scalar @_; return $self->{fptype} || 0; } sub fp { my $self = shift; return unpack "H*", $self->fpbin() unless scalar @_; return $self->fpbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub fpbin { my $self = shift; $self->{fpbin} = shift if scalar @_; return $self->{fpbin} || ""; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->fpbin ) : ''; } sub fingerprint { return &fp; } ## historical 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name SSHFP algorithm fptype fp'); =head1 DESCRIPTION DNS SSH Fingerprint (SSHFP) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The 8-bit algorithm number describes the algorithm used to construct the public key. =head2 fptype $fptype = $rr->fptype; $rr->fptype( $fptype ); The 8-bit fingerprint type number describes the message-digest algorithm used to calculate the fingerprint of the public key. =head2 fingerprint =head2 fp $fp = $rr->fp; $rr->fp( $fp ); Hexadecimal representation of the fingerprint digest. =head2 fpbin $fpbin = $rr->fpbin; $rr->fpbin( $fpbin ); Returns opaque octet string representing the fingerprint digest. =head2 babble print $rr->babble; The babble() method returns the 'BabbleBubble' representation of the fingerprint if the Digest::BubbleBabble package is available, otherwise an empty string is returned. Bubble babble represents a message digest as a string of "real" words, to make the fingerprint easier to remember. The "words" are not necessarily real words, but they look more like words than a string of hex characters. Bubble babble fingerprinting is used by the SSH2 suite (and consequently by Net::SSH::Perl, the Perl SSH implementation) to display easy-to-remember key fingerprints. The 'BubbleBabble' string is appended as a comment when the string method is called. =head1 COPYRIGHT Copyright (c)2007 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4255 =cut PK ! �[��H$ H$ DNSKEY.pmnu �[��� package Net::DNS::RR::DNSKEY; use strict; use warnings; our $VERSION = (qw$Id: DNSKEY.pm 1856 2021-12-02 14:36:25Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DNSKEY - DNS DNSKEY resource record =cut use integer; use Carp; use constant BASE64 => defined eval { require MIME::Base64 }; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $rdata = substr $$data, $offset, $self->{rdlength}; $self->{keybin} = unpack '@4 a*', $rdata; @{$self}{qw(flags protocol algorithm)} = unpack 'n C*', $rdata; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'n C2 a*', @{$self}{qw(flags protocol algorithm keybin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $algorithm = $self->{algorithm}; $self->_annotation( 'Key ID =', $self->keytag ) if $algorithm; return $self->SUPER::_format_rdata() unless BASE64; my @param = ( @{$self}{qw(flags protocol)}, $algorithm ); my @rdata = ( @param, split /\s+/, MIME::Base64::encode( $self->{keybin} ) || '-' ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my $flags = shift; ## avoid destruction by CDNSKEY algorithm(0) $self->protocol(shift); $self->algorithm(shift); $self->flags($flags); $self->key(@_); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->algorithm(1); $self->flags(256); $self->protocol(3); $self->keybin(''); return; } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; return $self->{flags} || 0; } sub zone { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x0100 | ( $_ || 0 ); $_ ^= 0x0100 unless shift; } } return 0x0100 & ( $self->{flags} || 0 ); } sub revoke { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x0080 | ( $_ || 0 ); $_ ^= 0x0080 unless shift; } } return 0x0080 & ( $self->{flags} || 0 ); } sub sep { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x0001 | ( $_ || 0 ); $_ ^= 0x0001 unless shift; } } return 0x0001 & ( $self->{flags} || 0 ); } sub protocol { my $self = shift; $self->{protocol} = 0 + shift if scalar @_; return $self->{protocol} || 0; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /\D/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if uc($arg) eq 'MNEMONIC'; return $self->{algorithm} = _algbyname($arg) || die _algbyname('') # disallow algorithm(0) } sub key { my $self = shift; return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_; return $self->keybin( MIME::Base64::decode( join "", @_ ) ); } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; return $self->{keybin} || ""; } sub publickey { return shift->key(@_); } sub privatekeyname { my $self = shift; my $name = $self->signame; return sprintf 'K%s+%03d+%05d.private', $name, $self->algorithm, $self->keytag; } sub signame { my $self = shift; return lc $self->{owner}->fqdn; } sub keylength { my $self = shift; my $keybin = $self->keybin || return; local $_ = _algbyval( $self->{algorithm} ); if (/^RSA/) { # Modulus length, see RFC 3110 if ( my $exp_length = unpack 'C', $keybin ) { return ( length($keybin) - $exp_length - 1 ) << 3; } else { $exp_length = unpack 'x n', $keybin; return ( length($keybin) - $exp_length - 3 ) << 3; } } elsif (/^DSA/) { # Modulus length, see RFC 2536 my $T = unpack 'C', $keybin; return ( $T << 6 ) + 512; } return length($keybin) << 2; ## ECDSA / EdDSA } sub keytag { my $self = shift; my $keybin = $self->keybin || return 0; # RFC4034 Appendix B.1: most significant 16 bits of least significant 24 bits return unpack 'n', substr $keybin, -3 if $self->{algorithm} == 1; # RFC4034 Appendix B my $od = length($keybin) & 1; my $rd = pack "n C2 a* x$od", @{$self}{qw(flags protocol algorithm)}, $keybin; my $ac = 0; $ac += $_ for unpack 'n*', $rd; $ac += ( $ac >> 16 ); return $ac & 0xFFFF; } ######################################## { my @algbyname = ( 'DELETE' => 0, # [RFC4034][RFC4398][RFC8078] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; foreach (@algbyname) { s/[\W_]//g; } # strip non-alphanumerics my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname; my %algbyname = @algrehash; # work around broken cperl sub _algbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $algbyname{$key}; return $val if defined $val; return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg]; } sub _algbyval { my $value = shift; return $algbyval{$value} || return $value; } } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name DNSKEY flags protocol algorithm publickey'); =head1 DESCRIPTION Class for DNSSEC Key (DNSKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); Unsigned 16-bit number representing Boolean flags. =over 4 =item zone $rr->zone(1); if ( $rr->zone ) { ... } Boolean ZONE flag. =back =over 4 =item revoke $rr->revoke(1); if ( $rr->revoke ) { ... } Boolean REVOKE flag. =back =over 4 =item sep $rr->sep(1); if ( $rr->sep ) { ... } Boolean Secure Entry Point (SEP) flag. =back =head2 protocol $protocol = $rr->protocol; $rr->protocol( $protocol ); The 8-bit protocol number. This field MUST have value 3. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The 8-bit algorithm number describes the public key algorithm. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 publickey =head2 key $key = $rr->key; $rr->key( $key ); Base64 representation of the public key material. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); Opaque octet string representing the public key material. =head2 privatekeyname $privatekeyname = $rr->privatekeyname; Returns the name of the privatekey as it would be generated by the BIND dnssec-keygen program. The format of that name being: K<fqdn>+<algorithm>+<keyid>.private =head2 signame Returns the canonical signer name of the privatekey. =head2 keylength Returns the length (in bits) of the modulus calculated from the key text. =head2 keytag print "keytag = ", $rr->keytag, "\n"; Returns the 16-bit numerical key tag of the key. (RFC2535 4.1.6) =head1 COPYRIGHT Copyright (c)2003-2005 RIPE NCC. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4034 L<DNSKEY Flags|http://www.iana.org/assignments/dnskey-flags> L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers> =cut PK ! � �� � CSYNC.pmnu �[��� package Net::DNS::RR::CSYNC; use strict; use warnings; our $VERSION = (qw$Id: CSYNC.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CSYNC - DNS CSYNC resource record =cut use integer; use Net::DNS::RR::NSEC; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{qw(soaserial flags)} = unpack "\@$offset Nn", $$data; $offset += 6; $self->{typebm} = substr $$data, $offset, $limit - $offset; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'N n a*', $self->soaserial, $self->flags, $self->{typebm}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = ( $self->soaserial, $self->flags, $self->typelist ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->soaserial(shift); $self->flags(shift); $self->typelist(@_); return; } sub soaserial { my $self = shift; $self->{soaserial} = 0 + shift if scalar @_; return $self->{soaserial} || 0; } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; return $self->{flags} || 0; } sub immediate { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x0001 | ( $_ || 0 ); $_ ^= 0x0001 unless shift; } } return 0x0001 & ( $self->{flags} || 0 ); } sub soaminimum { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x0002 | ( $_ || 0 ); $_ ^= 0x0002 unless shift; } } return 0x0002 & ( $self->{flags} || 0 ); } sub typelist { return &Net::DNS::RR::NSEC::typelist; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name CSYNC SOAserial flags typelist'); =head1 DESCRIPTION Class for DNSSEC CSYNC resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 SOAserial =head2 soaserial $soaserial = $rr->soaserial; $rr->soaserial( $soaserial ); The SOA Serial field contains a copy of the 32-bit SOA serial number from the child zone. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); The flags field contains 16 bits of boolean flags that define operations which affect the processing of the CSYNC record. =over 4 =item immediate $rr->immediate(1); if ( $rr->immediate ) { ... } If not set, a parental agent must not process the CSYNC record until the zone administrator approves the operation through an out-of-band mechanism. =back =over 4 =item soaminimum $rr->soaminimum(1); if ( $rr->soaminimum ) { ... } If set, a parental agent querying child authoritative servers must not act on data from zones advertising an SOA serial number less than the SOAserial value. =back =head2 typelist @typelist = $rr->typelist; $typelist = $rr->typelist; The type list indicates the record types to be processed by the parental agent. When called in scalar context, the list is interpolated into a string. =head1 COPYRIGHT Copyright (c)2015 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7477 =cut PK ! �Ӏ�} } ISDN.pmnu �[��� package Net::DNS::RR::ISDN; use strict; use warnings; our $VERSION = (qw$Id: ISDN.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::ISDN - DNS ISDN resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; ( $self->{address}, $offset ) = Net::DNS::Text->decode( $data, $offset ); ( $self->{sa}, $offset ) = Net::DNS::Text->decode( $data, $offset ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $address = $self->{address}; return join '', $address->encode, $self->{sa}->encode; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $address = $self->{address}; return join ' ', $address->string, $self->{sa}->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); $self->sa(@_); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->sa(''); return; } sub address { my $self = shift; $self->{address} = Net::DNS::Text->new(shift) if scalar @_; return $self->{address} ? $self->{address}->value : undef; } sub sa { my $self = shift; $self->{sa} = Net::DNS::Text->new(shift) if scalar @_; return $self->{sa} ? $self->{sa}->value : undef; } sub ISDNaddress { return &address; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name ISDN ISDNaddress sa'); =head1 DESCRIPTION Class for DNS ISDN resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 ISDNaddress =head2 address $address = $rr->address; $rr->address( $address ); The ISDN-address is a string of characters, normally decimal digits, beginning with the E.163 country code and ending with the DDI if any. =head2 sa $sa = $rr->sa; $rr->sa( $sa ); The optional subaddress (SA) is a string of hexadecimal digits. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 3.2 =cut PK ! ���� GPOS.pmnu �[��� package Net::DNS::RR::GPOS; use strict; use warnings; our $VERSION = (qw$Id: GPOS.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::GPOS - DNS GPOS resource record =cut use integer; use Carp; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{latitude}, $offset ) = Net::DNS::Text->decode( $data, $offset ) if $offset < $limit; ( $self->{longitude}, $offset ) = Net::DNS::Text->decode( $data, $offset ) if $offset < $limit; ( $self->{altitude}, $offset ) = Net::DNS::Text->decode( $data, $offset ) if $offset < $limit; croak('corrupt GPOS data') unless $offset == $limit; # more or less FUBAR return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{altitude}; return join '', map { $self->{$_}->encode } qw(latitude longitude altitude); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return '' unless defined $self->{altitude}; return join ' ', map { $self->{$_}->string } qw(latitude longitude altitude); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->latitude(shift); $self->longitude(shift); $self->altitude(shift); die 'too many arguments for GPOS' if scalar @_; return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata(qw(0.0 0.0 0.0)); return; } sub latitude { my $self = shift; $self->{latitude} = _fp2text(shift) if scalar @_; return defined(wantarray) ? _text2fp( $self->{latitude} ) : undef; } sub longitude { my $self = shift; $self->{longitude} = _fp2text(shift) if scalar @_; return defined(wantarray) ? _text2fp( $self->{longitude} ) : undef; } sub altitude { my $self = shift; $self->{altitude} = _fp2text(shift) if scalar @_; return defined(wantarray) ? _text2fp( $self->{altitude} ) : undef; } ######################################## sub _fp2text { return Net::DNS::Text->new( sprintf( '%1.10g', shift ) ); } sub _text2fp { no integer; return ( 0.0 + shift->value ); } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name GPOS latitude longitude altitude'); =head1 DESCRIPTION Class for DNS Geographical Position (GPOS) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 latitude $latitude = $rr->latitude; $rr->latitude( $latitude ); Floating-point representation of latitude, in degrees. =head2 longitude $longitude = $rr->longitude; $rr->longitude( $longitude ); Floating-point representation of longitude, in degrees. =head2 altitude $altitude = $rr->altitude; $rr->altitude( $altitude ); Floating-point representation of altitude, in metres. =head1 COPYRIGHT Copyright (c)1997,1998 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1712 =cut PK ! =)�5 MG.pmnu �[��� package Net::DNS::RR::MG; use strict; use warnings; our $VERSION = (qw$Id: MG.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MG - DNS MG resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{mgmname} = Net::DNS::DomainName1035->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $mgmname = $self->{mgmname} || return ''; return $mgmname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $mgmname = $self->{mgmname} || return ''; return $mgmname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->mgmname(shift); return; } sub mgmname { my $self = shift; $self->{mgmname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{mgmname} ? $self->{mgmname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name MG mgmname'); =head1 DESCRIPTION Class for DNS Mail Group (MG) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 mgmname $mgmname = $rr->mgmname; $rr->mgmname( $mgmname ); A domain name which specifies a mailbox which is a member of the mail group specified by the owner name. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.6 =cut PK ! �� � � CNAME.pmnu �[��� package Net::DNS::RR::CNAME; use strict; use warnings; our $VERSION = (qw$Id: CNAME.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CNAME - DNS CNAME resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{cname} = Net::DNS::DomainName1035->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $cname = $self->{cname}; return $cname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $cname = $self->{cname}; return $cname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->cname(shift); return; } sub cname { my $self = shift; $self->{cname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{cname} ? $self->{cname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name CNAME cname'); $rr = Net::DNS::RR->new( name => 'alias.example.com', type => 'CNAME', cname => 'example.com', ); =head1 DESCRIPTION Class for DNS Canonical Name (CNAME) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 cname $cname = $rr->cname; $rr->cname( $cname ); A domain name which specifies the canonical or primary name for the owner. The owner name is an alias. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2002-2003 Chris Reinhardt. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.1 =cut PK ! �.� NAPTR.pmnu �[��� package Net::DNS::RR::NAPTR; use strict; use warnings; our $VERSION = (qw$Id: NAPTR.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NAPTR - DNS NAPTR resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; @{$self}{qw(order preference)} = unpack "\@$offset n2", $$data; ( $self->{flags}, $offset ) = Net::DNS::Text->decode( $data, $offset + 4 ); ( $self->{service}, $offset ) = Net::DNS::Text->decode( $data, $offset ); ( $self->{regexp}, $offset ) = Net::DNS::Text->decode( $data, $offset ); $self->{replacement} = Net::DNS::DomainName2535->decode( $data, $offset, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $rdata = pack 'n2', @{$self}{qw(order preference)}; $rdata .= $self->{flags}->encode; $rdata .= $self->{service}->encode; $rdata .= $self->{regexp}->encode; $rdata .= $self->{replacement}->encode( $offset + length($rdata), @opaque ); return $rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @order = @{$self}{qw(order preference)}; my @rdata = ( @order, map { $_->string } @{$self}{qw(flags service regexp replacement)} ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(order preference flags service regexp replacement)) { $self->$_(shift) } return; } sub order { my $self = shift; $self->{order} = 0 + shift if scalar @_; return $self->{order} || 0; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub flags { my $self = shift; $self->{flags} = Net::DNS::Text->new(shift) if scalar @_; return $self->{flags} ? $self->{flags}->value : undef; } sub service { my $self = shift; $self->{service} = Net::DNS::Text->new(shift) if scalar @_; return $self->{service} ? $self->{service}->value : undef; } sub regexp { my $self = shift; $self->{regexp} = Net::DNS::Text->new(shift) if scalar @_; return $self->{regexp} ? $self->{regexp}->value : undef; } sub replacement { my $self = shift; $self->{replacement} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{replacement} ? $self->{replacement}->name : undef; } my $function = sub { my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b ); return $a->{order} <=> $b->{order} || $a->{preference} <=> $b->{preference}; }; __PACKAGE__->set_rrsort_func( 'order', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name NAPTR order preference flags service regexp replacement'); =head1 DESCRIPTION DNS Naming Authority Pointer (NAPTR) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 order $order = $rr->order; $rr->order( $order ); A 16-bit unsigned integer specifying the order in which the NAPTR records must be processed to ensure the correct ordering of rules. Low numbers are processed before high numbers. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16-bit unsigned integer that specifies the order in which NAPTR records with equal "order" values should be processed, low numbers being processed before high numbers. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); A string containing flags to control aspects of the rewriting and interpretation of the fields in the record. Flags are single characters from the set [A-Z0-9]. =head2 service $service = $rr->service; $rr->service( $service ); Specifies the service(s) available down this rewrite path. It may also specify the protocol used to communicate with the service. =head2 regexp $regexp = $rr->regexp; $rr->regexp; A string containing a substitution expression that is applied to the original string held by the client in order to construct the next domain name to lookup. =head2 replacement $replacement = $rr->replacement; $rr->replacement( $replacement ); The next NAME to query for NAPTR, SRV, or address records depending on the value of the flags field. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2005 Olaf Kolkman, NLnet Labs. Based on code contributed by Ryan Moats. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2915, RFC2168, RFC3403 =cut PK ! f. �� � TKEY.pmnu �[��� package Net::DNS::RR::TKEY; use strict; use warnings; our $VERSION = (qw$Id: TKEY.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::TKEY - DNS TKEY resource record =cut use integer; use Carp; use Net::DNS::Parameters qw(:class :type); use Net::DNS::DomainName; use constant ANY => classbyname qw(ANY); use constant TKEY => typebyname qw(TKEY); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode(@_); @{$self}{qw(inception expiration mode error)} = unpack "\@$offset N2n2", $$data; $offset += 12; my $key_size = unpack "\@$offset n", $$data; $self->{key} = substr $$data, $offset + 2, $key_size; $offset += $key_size + 2; my $other_size = unpack "\@$offset n", $$data; $self->{other} = substr $$data, $offset + 2, $other_size; $offset += $other_size + 2; croak('corrupt TKEY data') unless $offset == $limit; # more or less FUBAR return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return '' unless defined $self->{algorithm}; my $rdata = $self->{algorithm}->encode; $rdata .= pack 'N2n2', $self->inception, $self->expiration, $self->mode, $self->error; my $key = $self->key; # RFC2930(2.7) $rdata .= pack 'na*', length $key, $key; my $other = $self->other; # RFC2930(2.8) $rdata .= pack 'na*', length $other, $other; return $rdata; } sub class { ## overide RR method return 'ANY'; } sub encode { ## overide RR method my $self = shift; my $owner = $self->{owner}->encode(); my $rdata = eval { $self->_encode_rdata() } || ''; return pack 'a* n2 N n a*', $owner, TKEY, ANY, 0, length $rdata, $rdata; } sub algorithm { my $self = shift; $self->{algorithm} = Net::DNS::DomainName->new(shift) if scalar @_; return $self->{algorithm} ? $self->{algorithm}->name : undef; } sub inception { my $self = shift; $self->{inception} = 0 + shift if scalar @_; return $self->{inception} || 0; } sub expiration { my $self = shift; $self->{expiration} = 0 + shift if scalar @_; return $self->{expiration} || 0; } sub mode { my $self = shift; $self->{mode} = 0 + shift if scalar @_; return $self->{mode} || 0; } sub error { my $self = shift; $self->{error} = 0 + shift if scalar @_; return $self->{error} || 0; } sub key { my $self = shift; $self->{key} = shift if scalar @_; return $self->{key} || ""; } sub other { my $self = shift; $self->{other} = shift if scalar @_; return $self->{other} || ""; } sub other_data { return &other; } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; =head1 DESCRIPTION Class for DNS TSIG Key (TKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The algorithm name is in the form of a domain name with the same meaning as in [RFC 2845]. The algorithm determines how the secret keying material agreed to using the TKEY RR is actually used to derive the algorithm specific key. =head2 inception $inception = $rr->inception; $rr->inception( $inception ); Time expressed as the number of non-leap seconds modulo 2**32 since the beginning of January 1970 GMT. =head2 expiration $expiration = $rr->expiration; $rr->expiration( $expiration ); Time expressed as the number of non-leap seconds modulo 2**32 since the beginning of January 1970 GMT. =head2 mode $mode = $rr->mode; $rr->mode( $mode ); The mode field specifies the general scheme for key agreement or the purpose of the TKEY DNS message, as defined in [RFC2930(2.5)]. =head2 error $error = $rr->error; $rr->error( $error ); The error code field is an extended RCODE. =head2 key $key = $rr->key; $rr->key( $key ); Sequence of octets representing the key exchange data. The meaning of this data depends on the mode. =head2 other $other = $rr->other; $rr->other( $other ); Content not defined in the [RFC2930] specification but may be used in future extensions. =head1 COPYRIGHT Copyright (c)2000 Andrew Tridgell. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2930 =cut PK ! �r��� � LOC.pmnu �[��� package Net::DNS::RR::LOC; use strict; use warnings; our $VERSION = (qw$Id: LOC.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::LOC - DNS LOC resource record =cut use integer; use Carp; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $version = $self->{version} = unpack "\@$offset C", $$data; @{$self}{qw(size hp vp latitude longitude altitude)} = unpack "\@$offset xC3N3", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'C4N3', @{$self}{qw(version size hp vp latitude longitude altitude)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my ( $altitude, @precision ) = map { $self->$_() . 'm' } qw(altitude size hp vp); my $precision = join ' ', @precision; for ($precision) { s/^1m 10000m 10m$//; s/ 10000m 10m$//; s/ 10m$//; } return ( $self->latitude, '', $self->longitude, '', $altitude, $precision ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my @lat; while ( scalar @_ ) { my $this = shift; push( @lat, $this ); last if $this =~ /[NSns]/; } $self->latitude(@lat); my @long; while ( scalar @_ ) { my $this = shift; push( @long, $this ); last if $this =~ /[EWew]/; } $self->longitude(@long); foreach my $attr (qw(altitude size hp vp)) { $self->$attr(@_); shift; } return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->{version} = 0; $self->size(1); $self->hp(10000); $self->vp(10); return; } sub latitude { my $self = shift; $self->{latitude} = _encode_angle(@_) if scalar @_; return _decode_angle( $self->{latitude} || return, 'N', 'S' ); } sub longitude { my $self = shift; $self->{longitude} = _encode_angle(@_) if scalar @_; return _decode_angle( $self->{longitude} || return, 'E', 'W' ); } sub altitude { my $self = shift; $self->{altitude} = _encode_alt(shift) if scalar @_; return _decode_alt( $self->{altitude} ); } sub size { my $self = shift; $self->{size} = _encode_prec(shift) if scalar @_; return _decode_prec( $self->{size} ); } sub hp { my $self = shift; $self->{hp} = _encode_prec(shift) if scalar @_; return _decode_prec( $self->{hp} ); } sub horiz_pre { return &hp; } # uncoverable pod sub vp { my $self = shift; $self->{vp} = _encode_prec(shift) if scalar @_; return _decode_prec( $self->{vp} ); } sub vert_pre { return &vp; } # uncoverable pod sub latlon { my $self = shift; my ( $lat, @lon ) = @_; return ( scalar $self->latitude(@_), scalar $self->longitude(@lon) ); } sub version { return shift->{version}; } ######################################## no integer; use constant ALTITUDE0 => 10000000; use constant ORDINATE0 => 0x80000000; sub _decode_angle { my ( $msec, $N, $S ) = @_; return int( 0.5 + ( $msec - ORDINATE0 ) / 0.36 ) / 10000000 unless wantarray; use integer; my $abs = abs( $msec - ORDINATE0 ); my $deg = int( $abs / 3600000 ); my $min = int( $abs / 60000 ) % 60; no integer; my $sec = ( $abs % 60000 ) / 1000; return ( $deg, $min, $sec, ( $msec < ORDINATE0 ? $S : $N ) ); } sub _encode_angle { my @ang = scalar @_ > 1 ? (@_) : ( split /[\s\260'"]+/, shift ); my $ang = ( 0 + shift @ang ) * 3600000; my $neg = ( @ang ? pop @ang : '' ) =~ /[SWsw]/; $ang += ( @ang ? shift @ang : 0 ) * 60000; $ang += ( @ang ? shift @ang : 0 ) * 1000; return int( 0.5 + ( $neg ? ORDINATE0 - $ang : ORDINATE0 + $ang ) ); } sub _decode_alt { my $cm = ( shift || ALTITUDE0 ) - ALTITUDE0; return 0.01 * $cm; } sub _encode_alt { ( my $argument = shift ) =~ s/[Mm]$//; $argument += 0; return int( 0.5 + ALTITUDE0 + 100 * $argument ); } my @power10 = ( 0.01, 0.1, 1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 0, 0, 0, 0, 0 ); sub _decode_prec { my $argument = shift || 0; my $mantissa = $argument >> 4; return $mantissa * $power10[$argument & 0x0F]; } sub _encode_prec { ( my $argument = shift ) =~ s/[Mm]$//; my $exponent = 0; until ( $argument < $power10[1 + $exponent] ) { $exponent++ } my $mantissa = int( 0.5 + $argument / $power10[$exponent] ); return ( $mantissa & 0xF ) << 4 | $exponent; } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name LOC latitude longitude altitude size hp vp'); =head1 DESCRIPTION DNS geographical location (LOC) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 latitude $latitude = $rr->latitude; ($deg, $min, $sec, $ns ) = $rr->latitude; $rr->latitude( 42.357990 ); $rr->latitude( 42, 21, 28.764, 'N' ); $rr->latitude( '42 21 28.764 N' ); When invoked in scalar context, latitude is returned in degrees, a negative ordinate being south of the equator. When invoked in list context, latitude is returned as a list of separate degree, minute, and second values followed by N or S as appropriate. Optional replacement values may be represented as single value, list or formatted string. Trailing zero values are optional. =head2 longitude $longitude = $rr->longitude; ($deg, $min, $sec, $ew ) = $rr->longitude; $rr->longitude( -71.014338 ); $rr->longitude( 71, 0, 51.617, 'W' ); $rr->longitude( '71 0 51.617 W' ); When invoked in scalar context, longitude is returned in degrees, a negative ordinate being west of the prime meridian. When invoked in list context, longitude is returned as a list of separate degree, minute, and second values followed by E or W as appropriate. =head2 altitude $altitude = $rr->altitude; Represents altitude, in metres, relative to the WGS 84 reference spheroid used by GPS. =head2 size $size = $rr->size; Represents the diameter, in metres, of a sphere enclosing the described entity. =head2 hp $hp = $rr->hp; Represents the horizontal precision of the data expressed as the diameter, in metres, of the circle of error. =head2 vp $vp = $rr->vp; Represents the vertical precision of the data expressed as the total spread, in metres, of the distribution of possible values. =head2 latlon ($lat, $lon) = $rr->latlon; $rr->latlon($lat, $lon); Representation of the latitude and longitude coordinate pair as signed floating-point degrees. =head2 version $version = $rr->version; Version of LOC protocol. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2011 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1876 =cut PK ! �ZӠ� � TXT.pmnu �[��� package Net::DNS::RR::TXT; use strict; use warnings; our $VERSION = (qw$Id: TXT.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =encoding utf8 =head1 NAME Net::DNS::RR::TXT - DNS TXT resource record =cut use integer; use Carp; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $text; my $txtdata = $self->{txtdata} = []; while ( $offset < $limit ) { ( $text, $offset ) = Net::DNS::Text->decode( $data, $offset ); push @$txtdata, $text; } croak('corrupt TXT data') unless $offset == $limit; # more or less FUBAR return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $txtdata = $self->{txtdata}; return join '', map { $_->encode } @$txtdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $txtdata = $self->{txtdata}; return ( map { $_->unicode } @$txtdata ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->{txtdata} = [map { Net::DNS::Text->new($_) } @_]; return; } sub txtdata { my $self = shift; $self->{txtdata} = [map { Net::DNS::Text->new($_) } @_] if scalar @_; my $txtdata = $self->{txtdata} || []; return ( map { $_->value } @$txtdata ) if wantarray; return defined(wantarray) ? join( ' ', map { $_->value } @$txtdata ) : ''; } sub char_str_list { return (&txtdata); } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new( 'name TXT txtdata ...' ); $rr = Net::DNS::RR->new( name => 'name', type => 'TXT', txtdata => 'single text string' ); $rr = Net::DNS::RR->new( name => 'name', type => 'TXT', txtdata => [ 'multiple', 'strings', ... ] ); use utf8; $rr = Net::DNS::RR->new( 'jp TXT 古池や 蛙飛込む 水の音' ); =head1 DESCRIPTION Class for DNS Text (TXT) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 txtdata $string = $rr->txtdata; @list = $rr->txtdata; $rr->txtdata( @list ); When invoked in scalar context, txtdata() returns a concatenation of the descriptive text elements each separated by a single space character. In a list context, txtdata() returns a list of the text elements. =head1 COPYRIGHT Copyright (c)2011 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.14, RFC3629 =cut PK ! �4�l l RP.pmnu �[��� package Net::DNS::RR::RP; use strict; use warnings; our $VERSION = (qw$Id: RP.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::RP - DNS RP resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Mailbox; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; ( $self->{mbox}, $offset ) = Net::DNS::Mailbox2535->decode( $data, $offset, @opaque ); $self->{txtdname} = Net::DNS::DomainName2535->decode( $data, $offset, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $txtdname = $self->{txtdname}; my $rdata = $self->{mbox}->encode( $offset, @opaque ); $rdata .= $txtdname->encode( $offset + length($rdata), @opaque ); return $rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = ( $self->{mbox}->string, $self->{txtdname}->string ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->mbox(shift); $self->txtdname(shift); return; } sub mbox { my $self = shift; $self->{mbox} = Net::DNS::Mailbox2535->new(shift) if scalar @_; return $self->{mbox} ? $self->{mbox}->address : undef; } sub txtdname { my $self = shift; $self->{txtdname} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{txtdname} ? $self->{txtdname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name RP mbox txtdname'); =head1 DESCRIPTION Class for DNS Responsible Person (RP) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 mbox $mbox = $rr->mbox; $rr->mbox( $mbox ); A domain name which specifies the mailbox for the person responsible for this domain. The format in master files uses the DNS encoding convention for mailboxes, identical to that used for the RNAME mailbox field in the SOA RR. The root domain name (just ".") may be specified to indicate that no mailbox is available. =head2 txtdname $txtdname = $rr->txtdname; $rr->txtdname( $txtdname ); A domain name identifying TXT RRs. A subsequent query can be performed to retrieve the associated TXT records. This provides a level of indirection so that the entity can be referred to from multiple places in the DNS. The root domain name (just ".") may be specified to indicate that there is no associated TXT RR. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1183 Section 2.2 =cut PK ! 2$D HTTPS.pmnu �[��� package Net::DNS::RR::HTTPS; use strict; use warnings; our $VERSION = (qw$Id: HTTPS.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR::SVCB); =head1 NAME Net::DNS::RR::HTTPS - DNS HTTPS resource record =cut 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name HTTPS SvcPriority TargetName alpn=h3-29,h3-28,h3-27,h2 ...'); =head1 DESCRIPTION DNS HTTPS resource record The HTTPS class is derived from, and inherits all properties of, the Net::DNS::RR::SVCB class. Please see the L<Net::DNS::RR::SVCB> documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2020 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::SVCB> =cut PK ! �n>�* * SVCB.pmnu �[��� package Net::DNS::RR::SVCB; use strict; use warnings; our $VERSION = (qw$Id: SVCB.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SVCB - DNS SVCB resource record =cut use integer; use Carp; use MIME::Base64; use Net::DNS::DomainName; use Net::DNS::RR::A; use Net::DNS::RR::AAAA; use Net::DNS::Text; my %keybyname = ( mandatory => 'key0', alpn => 'key1', 'no-default-alpn' => 'key2', port => 'key3', ipv4hint => 'key4', ech => 'key5', ipv6hint => 'key6', ); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $rdata = substr $$data, $offset, $self->{rdlength}; $self->{SvcPriority} = unpack( 'n', $rdata ); my $index; ( $self->{TargetName}, $index ) = Net::DNS::DomainName->decode( \$rdata, 2 ); my $params = $self->{SvcParams} = []; my $limit = length($rdata) - 3; while ( $index < $limit ) { my ( $key, $size ) = unpack( "\@$index n2", $rdata ); push @$params, ( $key, substr $rdata, $index + 4, $size ); $index += ( $size + 4 ); } die $self->type . ': corrupt RDATA' unless $index == length($rdata); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my @packed = pack 'n a*', $self->{SvcPriority}, $self->{TargetName}->encode; my $params = $self->{SvcParams} || []; my @params = @$params; while (@params) { my $key = shift @params; my $val = shift @params; 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 = $self->{TargetName}->string; my $params = $self->{SvcParams} || []; return ( $priority, $target ) unless scalar @$params; my $encode = $self->{TargetName}->encode(); my $length = 2 + length $encode; my @target = split /(\S{32})/, unpack 'H*', $encode; my @rdata = unpack 'H4', pack 'n', $priority; push @rdata, "\t; priority: $priority\n"; push @rdata, shift @target; push @rdata, join '', "\t\t; target: ", substr( $target, 0, 50 ), "\n"; push @rdata, @target; my @params = @$params; while (@params) { my $key = shift @params; my $val = shift @params; push @rdata, "\n"; push @rdata, "; key$key=...\n" if $key > 15; push @rdata, unpack 'H4H4', pack( 'n2', $key, length $val ); push @rdata, split /(\S{32})/, unpack 'H*', $val; $length += 4 + length $val; } return ( "\\# $length", @rdata ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->svcpriority(shift); $self->targetname(shift); local $SIG{__WARN__} = sub { die @_ }; while ( my $svcparam = shift ) { for ($svcparam) { my @value; if (/^key\d+=(.*)$/i) { push @value, length($1) ? $1 : shift; } elsif (/=(.*)$/) { local $_ = length($1) ? $1 : shift; s/^"(.*)"$/$1/; # strip enclosing quotes push @value, split /,/; } else { push @value, '' unless $keybyname{lc $_}; # empty | Boolean } s/[-]/_/g; # extract identifier m/^([^=]+)/; $self->$1(@value); } } return; } sub _post_parse { ## parser post processing my $self = shift; my $paramref = $self->{SvcParams} || []; my %svcparam = scalar(@$paramref) ? @$paramref : return; $self->key0(undef); # ruse to force sorting of SvcParams if ( defined $svcparam{0} ) { my %unique; foreach ( grep { !$unique{$_}++ } unpack 'n*', $svcparam{0} ) { croak( $self->type . qq[: unexpected "key0" in mandatory list] ) if $unique{0}; croak( $self->type . qq[: duplicate "key$_" in mandatory list] ) if --$unique{$_}; croak( $self->type . qq[: mandatory "key$_" not present] ) unless defined $svcparam{$_}; } $self->mandatory( keys %unique ); # restore mandatory key list } croak( $self->type . qq[: expected alpn="..." not present] ) if defined( $svcparam{2} ) and !$svcparam{1}; return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata(qw(0 .)); return; } sub svcpriority { my $self = shift; # uncoverable pod $self->{SvcPriority} = 0 + shift if scalar @_; return $self->{SvcPriority} || 0; } sub targetname { my $self = shift; # uncoverable pod $self->{TargetName} = Net::DNS::DomainName->new(shift) if scalar @_; my $target = $self->{TargetName} ? $self->{TargetName}->name : return; return $target unless $self->{SvcPriority}; return ( $target eq '.' ) ? $self->owner : $target; } sub mandatory { ## mandatory=key1,port,... my $self = shift; my @list = map { $keybyname{lc $_} || $_ } map { split /,/ } @_; my @keys = map { /(\d+)$/ ? $1 : croak( $self->type . qq[: unexpected "$_"] ) } @list; return $self->key0( _integer16( sort { $a <=> $b } @keys ) ); } sub alpn { ## alpn=h3,h2,... my $self = shift; return $self->key1( _string(@_) ); } sub no_default_alpn { ## no-default-alpn my $self = shift; # uncoverable pod return $self->key2( ( defined(wantarray) ? @_ : '' ), @_ ); } sub port { ## port=1234 my $self = shift; return $self->key3( map { _integer16($_) } @_ ); } sub ipv4hint { ## ipv4hint=192.0.2.1,... my $self = shift; return $self->key4( _ipv4(@_) ); } sub ech { ## ech=base64string my $self = shift; return $self->key5( map { _base64($_) } @_ ); } sub ipv6hint { ## ipv6hint=2001:DB8::1,... my $self = shift; return $self->key6( _ipv6(@_) ); } ######################################## sub _presentation { ## render octet string(s) in presentation format return () unless scalar @_; my $raw = join '', @_; return Net::DNS::Text->decode( \$raw, 0, length($raw) )->string; } sub _base64 { return _presentation( map { MIME::Base64::decode($_) } @_ ); } sub _integer16 { return _presentation( map { pack( 'n', $_ ) } @_ ); } sub _ipv4 { return _presentation( map { Net::DNS::RR::A::address( {}, $_ ) } @_ ); } sub _ipv6 { return _presentation( map { Net::DNS::RR::AAAA::address( {}, $_ ) } @_ ); } sub _string { local $_ = join ',', '', @_; # reassemble argument string s/\\092,/\\044/g; ### tolerate unnecessary double-escape nonsense in s/\\092\\092/\\092/g; ### draft-ietf-dnsop-svcb-https that contradicts RFC1035 s/\\,/\\044/g; # disguise (RFC1035) escaped comma my ( undef, @reparsed ) = split /,/; # multi-valued argument return _presentation( map { Net::DNS::Text->new($_)->encode() } @reparsed ); } our $AUTOLOAD; sub AUTOLOAD { ## Dynamic constructor/accessor methods my $self = shift; my ($method) = reverse split /::/, $AUTOLOAD; my $super = "SUPER::$method"; return $self->$super(@_) unless $method =~ /^key[0]*(\d+)$/i; my $key = $1; my $paramsref = $self->{SvcParams} || []; my %svcparams = @$paramsref; if ( scalar @_ ) { my $arg = shift; # keyNN($value); delete $svcparams{$key} unless defined $arg; croak( $self->type . qq[: duplicate SvcParam "key$key"] ) if defined $svcparams{$key}; $svcparams{$key} = Net::DNS::Text->new("$arg")->raw if defined $arg; $self->{SvcParams} = [map { ( $_, $svcparams{$_} ) } sort { $a <=> $b } keys %svcparams]; croak( $self->type . qq[: unexpected number of values for "key$key"] ) if scalar @_; } else { croak( $self->type . qq[: no value specified for "key$key"] ) unless defined wantarray; } my $value = $svcparams{$key}; return defined($value) ? _presentation($value) : $value; } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name HTTPS SvcPriority TargetName SvcParams'); =head1 DESCRIPTION DNS Service Binding (SVCB) resource record Service binding and parameter specification via the DNS (SVCB and HTTPS RRs) =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 SvcPriority $svcpriority = $rr->svcpriority; $rr->svcpriority( $svcpriority ); The priority of this record (relative to others, with lower values preferred). A value of 0 indicates AliasMode. =head2 TargetName $rr->targetname( $targetname ); $effecivetarget = $rr->targetname; The domain name of either the alias target (for AliasMode) or the alternative endpoint (for ServiceMode). For AliasMode SVCB RRs, a TargetName of "." indicates that the service is not available or does not exist. For ServiceMode SVCB RRs, a TargetName of "." indicates that the owner name of this record must be used as the effective TargetName. =head2 mandatory, alpn, no-default-alpn, port, ipv4hint, ech, ipv6hint $rr = Net::DNS::RR->new( 'svcb.example. SVCB 1 svcb.example. port=1234' ); $rr->port(1234); $string = $rr->port(); # \004\210 $rr->key3($string); Constructor methods for mnemonic SvcParams defined in draft-ietf-dnsop-svcb-https. When invoked without arguments, the methods return the presentation format value for the underlying key. The behaviour with undefined arguments is not specified. =head2 keyNN $keynn = $rr->keyNN; $rr->keyNN( $keynn ); $rr->keyNN( undef ); Generic constructor and accessor methods for SvcParams. The key index NN is a decimal integer in the range 0 .. 65535. The method argument and returned value are both presentation format strings. The method returns the undefined value if the key is not present. The specified key will be deleted if the value is undefined. =head1 COPYRIGHT Copyright (c)2020-2021 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, draft-ietf-dnsop-svcb-https =cut PK ! �2�9� � PX.pmnu �[��� package Net::DNS::RR::PX; use strict; use warnings; our $VERSION = (qw$Id: PX.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::PX - DNS PX resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); ( $self->{map822}, $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque ); ( $self->{mapx400}, $offset ) = Net::DNS::DomainName2535->decode( $data, $offset + 0, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $mapx400 = $self->{mapx400}; my $rdata = pack( 'n', $self->{preference} ); $rdata .= $self->{map822}->encode( $offset + 2, @opaque ); $rdata .= $mapx400->encode( $offset + length($rdata), @opaque ); return $rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = ( $self->preference, $self->{map822}->string, $self->{mapx400}->string ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->map822(shift); $self->mapx400(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub map822 { my $self = shift; $self->{map822} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{map822} ? $self->{map822}->name : undef; } sub mapx400 { my $self = shift; $self->{mapx400} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{mapx400} ? $self->{mapx400}->name : undef; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name PX preference map822 mapx400'); =head1 DESCRIPTION Class for DNS X.400 Mail Mapping Information (PX) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer which specifies the preference given to this RR among others at the same owner. Lower values are preferred. =head2 map822 $map822 = $rr->map822; $rr->map822( $map822 ); A domain name element containing <rfc822-domain>, the RFC822 part of the MIXER Conformant Global Address Mapping. =head2 mapx400 $mapx400 = $rr->mapx400; $rr->mapx400( $mapx400 ); A <domain-name> element containing the value of <x400-in-domain-syntax> derived from the X.400 part of the MIXER Conformant Global Address Mapping. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2163 =cut PK ! 6��| OPENPGPKEY.pmnu �[��� package Net::DNS::RR::OPENPGPKEY; use strict; use warnings; our $VERSION = (qw$Id: OPENPGPKEY.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::OPENPGPKEY - DNS OPENPGPKEY resource record =cut use integer; use MIME::Base64; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $length = $self->{rdlength}; $self->keybin( substr $$data, $offset, $length ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'a*', $self->keybin; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @base64 = split /\s+/, encode_base64( $self->keybin ); return @base64; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->key(@_); return; } sub key { my $self = shift; return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_; return $self->keybin( MIME::Base64::decode( join "", @_ ) ); } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; return $self->{keybin} || ""; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name OPENPGPKEY key'); =head1 DESCRIPTION Class for OpenPGP Key (OPENPGPKEY) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 key $key = $rr->key; $rr->key( $key ); Base64 encoded representation of the OpenPGP public key material. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); OpenPGP public key material consisting of a single OpenPGP transferable public key in RFC4880 format. =head1 COPYRIGHT Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7929 =cut PK ! �X/� � APL.pmnu �[��� package Net::DNS::RR::APL; use strict; use warnings; our $VERSION = (qw$Id: APL.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::APL - DNS APL resource record =cut use integer; use Carp; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $aplist = $self->{aplist} = []; while ( $offset < $limit ) { my $xlen = unpack "\@$offset x3 C", $$data; my $size = ( $xlen & 0x7F ); my $item = bless {}, 'Net::DNS::RR::APL::Item'; $item->{negate} = $xlen - $size; @{$item}{qw(family prefix address)} = unpack "\@$offset n C x a$size", $$data; $offset += $size + 4; push @$aplist, $item; } croak('corrupt APL data') unless $offset == $limit; # more or less FUBAR return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my @rdata; my $aplist = $self->{aplist}; foreach (@$aplist) { my $address = $_->{address}; $address =~ s/[\000]+$//; # strip trailing null octets my $xlength = ( $_->{negate} ? 0x80 : 0 ) | length($address); push @rdata, pack 'n C2 a*', @{$_}{qw(family prefix)}, $xlength, $address; } return join '', @rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $aplist = $self->{aplist}; my @rdata = map { $_->string } @$aplist; return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->aplist(@_); return; } sub aplist { my $self = shift; while ( scalar @_ ) { # parse apitem strings last unless $_[0] =~ m#[!:./]#; shift =~ m#^(!?)(\d+):(.+)/(\d+)$#; my $n = $1 ? 1 : 0; my $f = $2 || 0; my $a = $3; my $p = $4 || 0; $self->aplist( negate => $n, family => $f, address => $a, prefix => $p ); } my $aplist = $self->{aplist} ||= []; if ( my %argval = @_ ) { # parse attribute=value list my $item = bless {}, 'Net::DNS::RR::APL::Item'; while ( my ( $attribute, $value ) = each %argval ) { $item->$attribute($value) unless $attribute eq 'address'; } $item->address( $argval{address} ); # address must be last push @$aplist, $item; } my @ap = @$aplist; return unless defined wantarray; return wantarray ? @ap : join ' ', map { $_->string } @ap; } ######################################## package Net::DNS::RR::APL::Item; ## no critic ProhibitMultiplePackages use Net::DNS::RR::A; use Net::DNS::RR::AAAA; my %family = qw(1 Net::DNS::RR::A 2 Net::DNS::RR::AAAA); sub negate { my $self = shift; return $self->{negate} = shift if scalar @_; return $self->{negate}; } sub family { my $self = shift; $self->{family} = 0 + shift if scalar @_; return $self->{family} || 0; } sub prefix { my $self = shift; $self->{prefix} = 0 + shift if scalar @_; return $self->{prefix} || 0; } sub address { my $self = shift; my $family = $family{$self->family} || die 'unknown address family'; return bless( {%$self}, $family )->address unless scalar @_; my $bitmask = $self->prefix; my $address = bless( {}, $family )->address(shift); return $self->{address} = pack "B$bitmask", unpack 'B*', $address; } sub string { my $self = shift; my $not = $self->{negate} ? '!' : ''; my ( $family, $address, $prefix ) = ( $self->family, $self->address, $self->prefix ); return "$not$family:$address/$prefix"; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN APL aplist'); =head1 DESCRIPTION DNS Address Prefix List (APL) record =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 aplist @aplist = $rr->aplist; @aplist = $rr->aplist( '1:192.168.32.0/21', '!1:192.168.38.0/28' ); @aplist = $rr->aplist( '1:224.0.0.0/4', '2:FF00:0:0:0:0:0:0:0/8' ); @aplist = $rr->aplist( negate => 1, family => 1, address => '192.168.38.0', prefix => 28, ); Ordered, possibly empty, list of address prefix items. Additional items, if present, are appended to the existing list with neither prefix aggregation nor reordering. =head2 Net::DNS::RR::APL::Item Each element of the prefix list is a Net::DNS::RR::APL::Item object which is inextricably bound to the APL record which created it. =head2 negate $rr->negate(1); if ( $rr->negate ) { ... } Boolean attribute indicating the prefix to be an address range exclusion. =head2 family $family = $rr->family; $rr->family( $family ); Address family discriminant. =head2 prefix $prefix = $rr->prefix; $rr->prefix( $prefix ); Number of bits comprising the address prefix. =head2 address $address = $object->address; Address portion of the prefix list item. =head2 string $string = $object->string; Returns the prefix list item in the form required in zone files. =head1 COPYRIGHT Copyright (c)2008 Olaf Kolkman, NLnet Labs. Portions Copyright (c)2011,2017 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC3123 =cut PK ! ��w � � TLSA.pmnu �[��� package Net::DNS::RR::TLSA; use strict; use warnings; our $VERSION = (qw$Id: TLSA.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::TLSA - DNS TLSA resource record =cut use integer; use Carp; use constant BABBLE => defined eval { require Digest::BubbleBabble }; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $next = $offset + $self->{rdlength}; @{$self}{qw(usage selector matchingtype)} = unpack "\@$offset C3", $$data; $offset += 3; $self->{certbin} = substr $$data, $offset, $next - $offset; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'C3 a*', @{$self}{qw(usage selector matchingtype certbin)}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; $self->_annotation( $self->babble ) if BABBLE; my @cert = split /(\S{64})/, $self->cert; my @rdata = ( $self->usage, $self->selector, $self->matchingtype, @cert ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->usage(shift); $self->selector(shift); $self->matchingtype(shift); $self->cert(@_); return; } sub usage { my $self = shift; $self->{usage} = 0 + shift if scalar @_; return $self->{usage} || 0; } sub selector { my $self = shift; $self->{selector} = 0 + shift if scalar @_; return $self->{selector} || 0; } sub matchingtype { my $self = shift; $self->{matchingtype} = 0 + shift if scalar @_; return $self->{matchingtype} || 0; } sub cert { my $self = shift; return unpack "H*", $self->certbin() unless scalar @_; return $self->certbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub certbin { my $self = shift; $self->{certbin} = shift if scalar @_; return $self->{certbin} || ""; } sub certificate { return &cert; } sub babble { return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->certbin ) : ''; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name TLSA usage selector matchingtype certificate'); =head1 DESCRIPTION The Transport Layer Security Authentication (TLSA) DNS resource record is used to associate a TLS server certificate or public key with the domain name where the record is found, forming a "TLSA certificate association". The semantics of how the TLSA RR is interpreted are described in RFC6698. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 usage $usage = $rr->usage; $rr->usage( $usage ); 8-bit integer value which specifies the provided association that will be used to match the certificate presented in the TLS handshake. =head2 selector $selector = $rr->selector; $rr->selector( $selector ); 8-bit integer value which specifies which part of the TLS certificate presented by the server will be matched against the association data. =head2 matchingtype $matchingtype = $rr->matchingtype; $rr->matchingtype( $matchingtype ); 8-bit integer value which specifies how the certificate association is presented. =head2 certificate =head2 cert $cert = $rr->cert; $rr->cert( $cert ); Hexadecimal representation of the certificate data. =head2 certbin $certbin = $rr->certbin; $rr->certbin( $certbin ); Binary representation of the certificate data. =head2 babble print $rr->babble; The babble() method returns the 'BubbleBabble' representation of the digest if the Digest::BubbleBabble package is available, otherwise an empty string is returned. BubbleBabble represents a message digest as a string of plausible words, to make the digest easier to verify. The "words" are not necessarily real words, but they look more like words than a string of hex characters. The 'BubbleBabble' string is appended as a comment when the string method is called. =head1 COPYRIGHT Copyright (c)2012 Willem Toorop, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6698 =cut PK ! ����� � HIP.pmnu �[��� package Net::DNS::RR::HIP; use strict; use warnings; our $VERSION = (qw$Id: HIP.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::HIP - DNS HIP resource record =cut use integer; use Carp; use Net::DNS::DomainName; use MIME::Base64; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my ( $hitlen, $pklen ) = unpack "\@$offset Cxn", $$data; @{$self}{qw(algorithm hitbin keybin)} = unpack "\@$offset xCxx a$hitlen a$pklen", $$data; my $limit = $offset + $self->{rdlength}; $offset += 4 + $hitlen + $pklen; $self->{servers} = []; while ( $offset < $limit ) { my $item; ( $item, $offset ) = Net::DNS::DomainName->decode( $data, $offset ); push @{$self->{servers}}, $item; } croak('corrupt HIP data') unless $offset == $limit; # more or less FUBAR return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $hit = $self->hitbin; my $key = $self->keybin; my $nos = pack 'C2n a* a*', length($hit), $self->algorithm, length($key), $hit, $key; return join '', $nos, map { $_->encode } @{$self->{servers}}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $base64 = MIME::Base64::encode( $self->{keybin}, '' ); my @server = map { $_->string } @{$self->{servers}}; my @rdata = ( $self->algorithm, $self->hit, $base64, @server ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach (qw(algorithm hit key)) { $self->$_(shift) } $self->servers(@_); return; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; return $self->{algorithm} || 0; } sub hit { my $self = shift; return unpack "H*", $self->hitbin() unless scalar @_; return $self->hitbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub hitbin { my $self = shift; $self->{hitbin} = shift if scalar @_; return $self->{hitbin} || ""; } sub key { my $self = shift; return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_; return $self->keybin( MIME::Base64::decode( join "", @_ ) ); } sub keybin { my $self = shift; $self->{keybin} = shift if scalar @_; return $self->{keybin} || ""; } sub servers { my $self = shift; my $servers = $self->{servers} ||= []; @$servers = map { Net::DNS::DomainName->new($_) } @_ if scalar @_; return defined(wantarray) ? map( { $_->name } @$servers ) : (); } sub rendezvousservers { ## historical $_[0]->_deprecate('prefer $rr->servers()'); # uncoverable pod my @servers = &servers; return \@servers; } sub pkalgorithm { ## historical return &algorithm; # uncoverable pod } sub pubkey { ## historical return &key; # uncoverable pod } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN HIP algorithm hit key servers'); =head1 DESCRIPTION Class for DNS Host Identity Protocol (HIP) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The PK algorithm field indicates the public key cryptographic algorithm and the implied public key field format. The values are those defined for the IPSECKEY algorithm type [RFC4025]. =head2 hit $hit = $rr->hit; $rr->hit( $hit ); The hexadecimal representation of the host identity tag. =head2 hitbin $hitbin = $rr->hitbin; $rr->hitbin( $hitbin ); The binary representation of the host identity tag. =head2 key $key = $rr->key; $rr->key( $key ); The hexadecimal representation of the public key. =head2 keybin $keybin = $rr->keybin; $rr->keybin( $keybin ); The binary representation of the public key. =head2 servers @servers = $rr->servers; Optional list of domain names of rendezvous servers. =head1 COPYRIGHT Copyright (c)2009 Olaf Kolkman, NLnet Labs All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8005 =cut PK ! lXL3� � CDNSKEY.pmnu �[��� package Net::DNS::RR::CDNSKEY; use strict; use warnings; our $VERSION = (qw$Id: CDNSKEY.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR::DNSKEY); =head1 NAME Net::DNS::RR::CDNSKEY - DNS CDNSKEY resource record =cut use integer; sub algorithm { my ( $self, $arg ) = @_; return $self->SUPER::algorithm($arg) if $arg; return $self->SUPER::algorithm() unless defined $arg; @{$self}{qw(flags protocol algorithm)} = ( 0, 3, 0 ); return; } sub key { my $self = shift; return $self->SUPER::key(@_) unless defined( $_[0] ) && length( $_[0] ) < 2; return $self->SUPER::keybin( $_[0] ? '' : chr(0) ); } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name CDNSKEY flags protocol algorithm publickey'); =head1 DESCRIPTION DNS Child DNSKEY resource record This is a clone of the DNSKEY record and inherits all properties of the Net::DNS::RR::DNSKEY class. Please see the L<Net::DNS::RR::DNSKEY> perl documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2014,2017 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::DNSKEY>, RFC7344, RFC8078(erratum 5049) =cut PK ! ��r?� � MB.pmnu �[��� package Net::DNS::RR::MB; use strict; use warnings; our $VERSION = (qw$Id: MB.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MB - DNS MB resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{madname} = Net::DNS::DomainName1035->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $madname = $self->{madname} || return ''; return $madname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $madname = $self->{madname} || return ''; return $madname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->madname(shift); return; } sub madname { my $self = shift; $self->{madname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{madname} ? $self->{madname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name MB madname'); =head1 DESCRIPTION Class for DNS Mailbox (MB) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 madname $madname = $rr->madname; $rr->madname( $madname ); A domain name which specifies a host which has the specified mailbox. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.3 =cut PK ! KxW � � URI.pmnu �[��� package Net::DNS::RR::URI; use strict; use warnings; our $VERSION = (qw$Id: URI.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::URI - DNS URI resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{qw(priority weight)} = unpack( "\@$offset n2", $$data ); $offset += 4; $self->{target} = Net::DNS::Text->decode( $data, $offset, $limit - $offset ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $target = $self->{target}; return pack 'n2 a*', @{$self}{qw(priority weight)}, $target->raw; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target}; my @rdata = ( $self->priority, $self->weight, $target->string ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->$_(shift) foreach qw(priority weight target); return; } sub priority { my $self = shift; $self->{priority} = 0 + shift if scalar @_; return $self->{priority} || 0; } sub weight { my $self = shift; $self->{weight} = 0 + shift if scalar @_; return $self->{weight} || 0; } sub target { my $self = shift; $self->{target} = Net::DNS::Text->new(shift) if scalar @_; return $self->{target} ? $self->{target}->value : undef; } # order RRs by numerically increasing priority, decreasing weight my $function = sub { my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b ); return $a->{priority} <=> $b->{priority} || $b->{weight} <=> $a->{weight}; }; __PACKAGE__->set_rrsort_func( 'priority', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name URI priority weight target'); =head1 DESCRIPTION Class for DNS Service (URI) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 priority $priority = $rr->priority; $rr->priority( $priority ); The priority of the target URI in this RR. The range of this number is 0-65535. A client MUST attempt to contact the URI with the lowest-numbered priority it can reach; weighted selection being used to distribute load across targets with equal priority. =head2 weight $weight = $rr->weight; $rr->weight( $weight ); A server selection mechanism. The weight field specifies a relative weight for entries with the same priority. Larger weights SHOULD be given a proportionately higher probability of being selected. The range of this number is 0-65535. =head2 target $target = $rr->target; $rr->target( $target ); The URI of the target. Resolution of the URI is according to the definitions for the Scheme of the URI. =head1 COPYRIGHT Copyright (c)2015 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7553 =cut PK ! `� MX.pmnu �[��� package Net::DNS::RR::MX; use strict; use warnings; our $VERSION = (qw$Id: MX.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::MX - DNS MX resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{exchange} = Net::DNS::DomainName1035->decode( $data, $offset + 2, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $exchange = $self->{exchange}; return pack 'n a*', $self->preference, $exchange->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $exchange = $self->{exchange}; return join ' ', $self->preference, $exchange->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->exchange(shift); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->preference(10); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub exchange { my $self = shift; $self->{exchange} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{exchange} ? $self->{exchange}->name : undef; } my $function = sub { ## sort RRs in numerically ascending order. return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name MX preference exchange'); =head1 DESCRIPTION DNS Mail Exchanger (MX) resource record =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer which specifies the preference given to this RR among others at the same owner. Lower values are preferred. =head2 exchange $exchange = $rr->exchange; $rr->exchange( $exchange ); A domain name which specifies a host willing to act as a mail exchange for the owner name. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.9 =cut PK ! >���> > DNAME.pmnu �[��� package Net::DNS::RR::DNAME; use strict; use warnings; our $VERSION = (qw$Id: DNAME.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::DNAME - DNS DNAME resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{target} = Net::DNS::DomainName2535->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $target = $self->{target}; return $target->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target}; return $target->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->target(shift); return; } sub target { my $self = shift; $self->{target} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{target} ? $self->{target}->name : undef; } sub dname { return ⌖ } # uncoverable pod 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name DNAME target'); =head1 DESCRIPTION Class for DNS Non-Terminal Name Redirection (DNAME) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 target $target = $rr->target; $rr->target( $target ); Redirection target domain name which is to be substituted for its owner as a suffix of a domain name. =head1 COPYRIGHT Copyright (c)2002 Andreas Gustafsson. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC6672 =cut PK ! �?�� � EUI64.pmnu �[��� package Net::DNS::RR::EUI64; use strict; use warnings; our $VERSION = (qw$Id: EUI64.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::EUI64 - DNS EUI64 resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a8", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'a8', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return $self->address; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); return; } sub address { my ( $self, $address ) = @_; $self->{address} = pack 'C8', map { hex($_) } split /[:-]/, $address if $address; return defined(wantarray) ? join '-', unpack( 'H2H2H2H2H2H2H2H2', $self->{address} ) : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN EUI64 address'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'EUI64', address => '00-00-5e-ef-10-00-00-2a' ); =head1 DESCRIPTION DNS resource records for 64-bit Extended Unique Identifier (EUI64). The EUI64 resource record is used to represent IEEE Extended Unique Identifiers used in various layer-2 networks, ethernet for example. EUI64 addresses SHOULD NOT be published in the public DNS. RFC7043 describes potentially severe privacy implications resulting from indiscriminate publication of link-layer addresses in the DNS. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address The address field is a 8-octet layer-2 address in network byte order. The presentation format is hexadecimal separated by "-". =head1 COPYRIGHT Copyright (c)2013 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC7043 =cut PK ! ��� ( ( NSEC.pmnu �[��� package Net::DNS::RR::NSEC; use strict; use warnings; our $VERSION = (qw$Id: NSEC.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NSEC - DNS NSEC resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Parameters qw(:type); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{nxtdname}, $offset ) = Net::DNS::DomainName->decode(@_); $self->{typebm} = substr $$data, $offset, $limit - $offset; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $nxtdname = $self->{nxtdname}; return join '', $nxtdname->encode(), $self->{typebm}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $nxtdname = $self->{nxtdname}; return ( $nxtdname->string(), $self->typelist ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->nxtdname(shift); $self->typelist(@_); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata('.'); return; } sub nxtdname { my $self = shift; $self->{nxtdname} = Net::DNS::DomainName->new(shift) if scalar @_; return $self->{nxtdname} ? $self->{nxtdname}->name : undef; } sub typelist { my $self = shift; if ( scalar(@_) || !defined(wantarray) ) { $self->{typebm} = &_type2bm; return; } my @type = &_bm2type( $self->{typebm} ); return wantarray ? (@type) : "@type"; } sub typemap { my $self = shift; my $number = typebyname(shift); my $window = $number >> 8; my $bitnum = $number & 255; my $typebm = $self->{typebm} || return; my @bitmap; my $index = 0; while ( $index < length $typebm ) { my ( $block, $size ) = unpack "\@$index C2", $typebm; $bitmap[$block] = unpack "\@$index xxa$size", $typebm; $index += $size + 2; } my @bit = split //, unpack 'B*', ( $bitmap[$window] || return ); return $bit[$bitnum]; } sub match { my $self = shift; my $name = Net::DNS::DomainName->new(shift)->canonical; return $name eq $self->{owner}->canonical; } sub covers { my $self = shift; my $name = join chr(0), reverse Net::DNS::DomainName->new(shift)->_wire; my $this = join chr(0), reverse $self->{owner}->_wire; my $next = join chr(0), reverse $self->{nxtdname}->_wire; foreach ( $name, $this, $next ) {tr /\101-\132/\141-\172/} return ( $name cmp $this ) + ( "$next\001" cmp $name ) == 2 unless $next gt $this; return ( $name cmp $this ) + ( $next cmp $name ) == 2; } sub encloser { my $self = shift; my @qname = Net::DNS::Domain->new(shift)->label; my @owner = $self->{owner}->label; my $depth = scalar(@owner); my $next; while ( scalar(@qname) > $depth ) { $next = shift @qname; } return unless defined $next; my $nextcloser = join( '.', $next, @qname ); return if lc($nextcloser) ne lc( join '.', $next, @owner ); $self->{nextcloser} = $nextcloser; $self->{wildcard} = join( '.', '*', @qname ); return $self->owner; } sub nextcloser { return shift->{nextcloser}; } sub wildcard { return shift->{wildcard}; } ######################################## sub _type2bm { my @typearray; foreach my $typename ( map { split() } @_ ) { my $number = typebyname($typename); my $window = $number >> 8; my $bitnum = $number & 255; my $octet = $bitnum >> 3; my $bit = $bitnum & 7; $typearray[$window][$octet] |= 0x80 >> $bit; } my $bitmap = ''; my $window = 0; foreach (@typearray) { if ( my $pane = $typearray[$window] ) { my @content = map { $_ || 0 } @$pane; $bitmap .= pack 'CC C*', $window, scalar(@content), @content; } $window++; } return $bitmap; } sub _bm2type { my @typelist; my $bitmap = shift || return @typelist; my $index = 0; my $limit = length $bitmap; while ( $index < $limit ) { my ( $block, $size ) = unpack "\@$index C2", $bitmap; my $typenum = $block << 8; foreach my $octet ( unpack "\@$index xxC$size", $bitmap ) { my $i = $typenum += 8; my @name; while ($octet) { --$i; unshift @name, typebyval($i) if $octet & 1; $octet = $octet >> 1; } push @typelist, @name; } $index += $size + 2; } return @typelist; } sub typebm { ## historical my $self = shift; # uncoverable pod $self->{typebm} = shift if scalar @_; $self->_deprecate('prefer $rr->typelist() or $rr->typemap()'); return $self->{typebm}; } sub covered { ## historical my $self = shift; # uncoverable pod return $self->covers(@_); } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new( 'name NSEC nxtdname typelist' ); =head1 DESCRIPTION Class for DNSSEC NSEC resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 nxtdname $nxtdname = $rr->nxtdname; $rr->nxtdname( $nxtdname ); The Next Domain field contains the next owner name (in the canonical ordering of the zone) that has authoritative data or contains a delegation point NS RRset. =head2 typelist @typelist = $rr->typelist; $typelist = $rr->typelist; typelist() identifies the RRset types that exist at the NSEC RR owner name. When called in scalar context, the list is interpolated into a string. =head2 typemap $exists = $rr->typemap($rrtype); typemap() returns a Boolean true value if the specified RRtype occurs in the type bitmap of the NSEC record. =head2 match $matched = $rr->match( 'example.foo' ); match() returns a Boolean true value if the canonical form of the name argument matches the canonical owner name of the NSEC RR. =head2 covers $covered = $rr->covers( 'example.foo' ); covers() returns a Boolean true value if the canonical form of the name, or one of its ancestors, falls between the owner name and the nxtdname field of the NSEC record. =head2 encloser, nextcloser, wildcard $encloser = $rr->encloser( 'example.foo' ); print "encloser: $encloser\n" if $encloser; encloser() returns the name of a provable encloser of the query name argument obtained from the NSEC RR. nextcloser() returns the next closer name, which is one label longer than the closest encloser. This is only valid after encloser() has returned a valid domain name. wildcard() returns the unexpanded wildcard name from which the next closer name was possibly synthesised. This is only valid after encloser() has returned a valid domain name. =head1 COPYRIGHT Copyright (c)2001-2005 RIPE NCC. Author Olaf M. Kolkman Portions Copyright (c)2018-2019 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4034, RFC9077 =cut PK ! ���� � SPF.pmnu �[��� package Net::DNS::RR::SPF; use strict; use warnings; our $VERSION = (qw$Id: SPF.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR::TXT); =head1 NAME Net::DNS::RR::SPF - DNS SPF resource record =cut use integer; sub spfdata { my @spf = shift->char_str_list(@_); return wantarray ? @spf : join '', @spf; } sub txtdata { return &spfdata; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name SPF spfdata ...'); $rr = Net::DNS::RR->new( name => 'name', type => 'SPF', spfdata => 'single text string' ); $rr = Net::DNS::RR->new( name => 'name', type => 'SPF', spfdata => [ 'multiple', 'strings', ... ] ); =head1 DESCRIPTION Class for DNS Sender Policy Framework (SPF) resource records. SPF records inherit most of the properties of the Net::DNS::RR::TXT class. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 spfdata =head2 txtdata $string = $rr->spfdata; @list = $rr->spfdata; $rr->spfdata( @list ); When invoked in scalar context, spfdata() returns the policy text as a single string, with text elements concatenated without intervening spaces. In a list context, spfdata() returns a list of the text elements. =head1 COPYRIGHT Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::TXT>, RFC7208 =cut PK ! �rCl�] �] RRSIG.pmnu �[��� package Net::DNS::RR::RRSIG; use strict; use warnings; our $VERSION = (qw$Id: RRSIG.pm 1856 2021-12-02 14:36:25Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::RRSIG - DNS RRSIG resource record =cut use integer; use Carp; use Time::Local; use Net::DNS::Parameters qw(:type); use constant DEBUG => 0; use constant UTIL => defined eval { require Scalar::Util; }; eval { require MIME::Base64 }; # IMPORTANT: Downstream distros MUST NOT create dependencies on Net::DNS::SEC (strong crypto prohibited in many territories) use constant USESEC => defined $INC{'Net/DNS/SEC.pm'}; # Discover how we got here, without exposing any crypto use constant # Discourage static code analysers and casual greppers DNSSEC => USESEC && defined eval join '', qw(r e q u i r e), ' Net::DNS', qw(:: SEC :: Private); ## no critic my @index; if (DNSSEC) { foreach my $class ( map {"Net::DNS::SEC::$_"} qw(RSA DSA ECCGOST ECDSA EdDSA) ) { my @algorithms = eval join '', qw(r e q u i r e), " $class; $class->_index"; ## no critic push @index, map { ( $_ => $class ) } @algorithms; } croak 'Net::DNS::SEC version not supported' unless scalar(@index); } my %DNSSEC_verify = @index; my %DNSSEC_siggen = @index; my @deprecated = ( 1, 3, 6, 12 ); # RFC8624 delete @DNSSEC_siggen{@deprecated}; my @field = qw(typecovered algorithm labels orgttl sigexpiration siginception keytag); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; @{$self}{@field} = unpack "\@$offset n C2 N3 n", $$data; ( $self->{signame}, $offset ) = Net::DNS::DomainName->decode( $data, $offset + 18 ); $self->{sigbin} = substr $$data, $offset, $limit - $offset; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $signame = $self->{signame}; return pack 'n C2 N3 n a* a*', @{$self}{@field}, $signame->canonical, $self->sigbin; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $signame = $self->{signame}; my @sig64 = split /\s+/, MIME::Base64::encode( $self->sigbin ); my @rdata = ( map( { $self->$_ } @field ), $signame->string, @sig64 ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach ( @field, qw(signame) ) { $self->$_(shift) } $self->signature(@_); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->sigval(30); return; } sub typecovered { my $self = shift; $self->{typecovered} = typebyname(shift) if scalar @_; my $typecode = $self->{typecovered}; return defined $typecode ? typebyval($typecode) : undef; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _algbyname($argn) : _algbyval($argn); } return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _algbyname($arg); } sub labels { my $self = shift; $self->{labels} = 0 + shift if scalar @_; return $self->{labels} || 0; } sub orgttl { my $self = shift; $self->{orgttl} = 0 + shift if scalar @_; return $self->{orgttl} || 0; } sub sigexpiration { my $self = shift; $self->{sigexpiration} = _string2time(shift) if scalar @_; my $time = $self->{sigexpiration}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub siginception { my $self = shift; $self->{siginception} = _string2time(shift) if scalar @_; my $time = $self->{siginception}; return unless defined wantarray && defined $time; return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time); } sub sigex { return &sigexpiration; } ## historical sub sigin { return &siginception; } ## historical sub sigval { my $self = shift; no integer; return ( $self->{sigval} ) = map { int( 86400 * $_ ) } @_; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; return $self->{keytag} || 0; } sub signame { my $self = shift; $self->{signame} = Net::DNS::DomainName->new(shift) if scalar @_; return $self->{signame} ? $self->{signame}->name : undef; } sub sig { my $self = shift; return MIME::Base64::encode( $self->sigbin(), "" ) unless scalar @_; return $self->sigbin( MIME::Base64::decode( join "", @_ ) ); } sub sigbin { my $self = shift; $self->{sigbin} = shift if scalar @_; return $self->{sigbin} || ""; } sub signature { return &sig; } sub create { unless (DNSSEC) { croak qq[No "use Net::DNS::SEC" declaration in application code]; } else { my ( $class, $rrsetref, $priv_key, %etc ) = @_; $rrsetref = [$rrsetref] unless ref($rrsetref) eq 'ARRAY'; my $RR = $rrsetref->[0]; croak '$rrsetref is not reference to RR array' unless ref($RR) =~ /^Net::DNS::RR/; # All the TTLs need to be the same in the data RRset. my $ttl = $RR->ttl; croak 'RRs in RRset do not have same TTL' if grep { $_->ttl != $ttl } @$rrsetref; my $private = ref($priv_key) ? $priv_key : Net::DNS::SEC::Private->new($priv_key); croak 'unable to parse private key' unless ref($private) eq 'Net::DNS::SEC::Private'; my @label = grep { $_ ne chr(42) } $RR->{owner}->_wire; # count labels my $self = Net::DNS::RR->new( name => $RR->name, type => 'RRSIG', class => 'IN', ttl => $ttl, typecovered => $RR->type, labels => scalar @label, orgttl => $ttl, siginception => time(), algorithm => $private->algorithm, keytag => $private->keytag, signame => $private->signame, ); while ( my ( $attribute, $value ) = each %etc ) { $self->$attribute($value); } $self->{sigexpiration} = $self->{siginception} + $self->{sigval} unless $self->{sigexpiration}; my $sigdata = $self->_CreateSigData($rrsetref); $self->_CreateSig( $sigdata, $private ); return $self; } } sub verify { # Reminder... # $rrsetref must be a reference to an array of RR objects. # $keyref is either a key object or a reference to an array of key objects. unless (DNSSEC) { croak qq[No "use Net::DNS::SEC" declaration in application code]; } else { my ( $self, $rrsetref, $keyref ) = @_; croak '$keyref argument is scalar or undefined' unless ref($keyref); print '$keyref argument is ', ref($keyref), "\n" if DEBUG; if ( ref($keyref) eq "ARRAY" ) { # We will iterate over the supplied key list and # return when there is a successful verification. # If not, continue so that we survive key-id collision. print "Iterating over ", scalar(@$keyref), " keys\n" if DEBUG; my @error; foreach my $keyrr (@$keyref) { my $result = $self->verify( $rrsetref, $keyrr ); return $result if $result; my $error = $self->{vrfyerrstr}; my $keyid = $keyrr->keytag; push @error, "key $keyid: $error"; print "key $keyid: $error\n" if DEBUG; next; } $self->{vrfyerrstr} = join "\n", @error; return 0; } elsif ( $keyref->isa('Net::DNS::RR::DNSKEY') ) { print "Validating using key with keytag: ", $keyref->keytag, "\n" if DEBUG; } else { croak join ' ', ref($keyref), 'can not be used as DNSSEC key'; } $rrsetref = [$rrsetref] unless ref($rrsetref) eq 'ARRAY'; my $RR = $rrsetref->[0]; croak '$rrsetref not a reference to array of RRs' unless ref($RR) =~ /^Net::DNS::RR/; if (DEBUG) { print "\n ---------------------- RRSIG DEBUG --------------------"; print "\n SIG:\t", $self->string; print "\n KEY:\t", $keyref->string; print "\n -------------------------------------------------------\n"; } $self->{vrfyerrstr} = ''; unless ( $self->algorithm == $keyref->algorithm ) { $self->{vrfyerrstr} = 'algorithm does not match'; return 0; } unless ( $self->keytag == $keyref->keytag ) { $self->{vrfyerrstr} = 'keytag does not match'; return 0; } my $sigdata = $self->_CreateSigData($rrsetref); $self->_VerifySig( $sigdata, $keyref ) || return 0; # time to do some time checking. my $t = time; if ( _ordered( $self->{sigexpiration}, $t ) ) { $self->{vrfyerrstr} = join ' ', 'Signature expired at', $self->sigexpiration; return 0; } elsif ( _ordered( $t, $self->{siginception} ) ) { $self->{vrfyerrstr} = join ' ', 'Signature valid from', $self->siginception; return 0; } return 1; } } #END verify sub vrfyerrstr { my $self = shift; return $self->{vrfyerrstr}; } ######################################## { my @algbyname = ( 'DELETE' => 0, # [RFC4034][RFC4398][RFC8078] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; foreach (@algbyname) { s/[\W_]//g; } # strip non-alphanumerics my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname; my %algbyname = @algrehash; # work around broken cperl sub _algbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $algbyname{$key}; return $val if defined $val; return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg]; } sub _algbyval { my $value = shift; return $algbyval{$value} || return $value; } } sub _CreateSigData { # This method creates the data string that will be signed. # See RFC4034(6) and RFC6840(5.1) on how this string is constructed # This method is called by the method that creates a signature # and by the method that verifies the signature. It is assumed # that the creation method has checked that all the TTLs are # the same for the rrsetref and that sig->orgttl has been set # to the TTL of the data. This method will set the datarr->ttl # to the sig->orgttl for all the RR in the rrsetref. if (DNSSEC) { my ( $self, $rrsetref ) = @_; print "_CreateSigData\n" if DEBUG; my $sigdata = pack 'n C2 N3 n a*', @{$self}{@field}, $self->{signame}->canonical; print "\npreamble\t", unpack( 'H*', $sigdata ), "\n" if DEBUG; my $owner = $self->{owner}; # create wildcard domain name my $limit = $self->{labels}; my @label = $owner->_wire; shift @label while scalar @label > $limit; my $wild = bless {label => \@label}, ref($owner); # DIY to avoid wrecking name cache my $suffix = $wild->canonical; unshift @label, chr(42); # asterisk my @RR = map { bless( {%$_}, ref($_) ) } @$rrsetref; # shallow RR clone my $rr = $RR[0]; my $class = $rr->class; my $type = $rr->type; my $ttl = $self->orgttl; my %table; foreach my $RR (@RR) { my $ident = $RR->{owner}->canonical; my $match = substr $ident, -length($suffix); croak 'RRs in RRset have different NAMEs' if $match ne $suffix; croak 'RRs in RRset have different TYPEs' if $type ne $RR->type; croak 'RRs in RRset have different CLASS' if $class ne $RR->class; $RR->ttl($ttl); # reset TTL my $offset = 10 + length($suffix); # RDATA offset if ( $ident ne $match ) { $RR->{owner} = $wild; $offset += 2; print "\nsubstituting wildcard name: ", $RR->name if DEBUG; } # For sorting we create a hash table of canonical data keyed on RDATA my $canonical = $RR->canonical; $table{substr $canonical, $offset} = $canonical; } $sigdata = join '', $sigdata, map { $table{$_} } sort keys %table; if (DEBUG) { my $i = 0; foreach my $rdata ( sort keys %table ) { print "\n>>> ", $i++, "\tRDATA:\t", unpack 'H*', $rdata; print "\nRR: ", unpack( 'H*', $table{$rdata} ), "\n"; } print "\n sigdata:\t", unpack( 'H*', $sigdata ), "\n"; } return $sigdata; } } sub _CreateSig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $DNSSEC_siggen{$algorithm}; return eval { die "algorithm $algorithm not supported\n" unless $class; $self->sigbin( $class->sign(@_) ); } || return croak "${@}signature generation failed"; } } sub _VerifySig { if (DNSSEC) { my $self = shift; my $algorithm = $self->algorithm; my $class = $DNSSEC_verify{$algorithm}; my $retval = eval { die "algorithm $algorithm not supported\n" unless $class; $class->verify( @_, $self->sigbin ); }; unless ($retval) { $self->{vrfyerrstr} = "${@}signature verification failed"; print "\n", $self->{vrfyerrstr}, "\n" if DEBUG; return 0; } # uncoverable branch true # bug in Net::DNS::SEC or dependencies croak "unknown error in $class->verify" unless $retval == 1; print "\nalgorithm $algorithm verification successful\n" if DEBUG; return 1; } } sub _ordered() { ## irreflexive 32-bit partial ordering use integer; my ( $n1, $n2 ) = @_; return 0 unless defined $n2; # ( any, undef ) return 1 unless defined $n1; # ( undef, any ) # unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished if ( $n2 < 0 ) { # fold, leaving $n2 non-negative $n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000; # -2**31 <= $n1 < 2**32 $n2 = ( $n2 & 0x7FFFFFFF ); # 0 <= $n2 < 2**31 } return $n1 < $n2 ? ( $n1 > ( $n2 - 0x80000000 ) ) : ( $n2 < ( $n1 - 0x80000000 ) ); } my $y1998 = timegm( 0, 0, 0, 1, 0, 1998 ); my $y2026 = timegm( 0, 0, 0, 1, 0, 2026 ); my $y2082 = $y2026 << 1; my $y2054 = $y2082 - $y1998; my $m2026 = int( 0x80000000 - $y2026 ); my $m2054 = int( 0x80000000 - $y2054 ); my $t2082 = int( $y2082 & 0x7FFFFFFF ); my $t2100 = 1960058752; sub _string2time { ## parse time specification string my $arg = shift; return int($arg) if length($arg) < 12; my ( $y, $m, @dhms ) = unpack 'a4 a2 a2 a2 a2 a2', $arg . '00'; if ( $arg lt '20380119031408' ) { # calendar folding return timegm( reverse(@dhms), $m - 1, $y ) if $y < 2026; return timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2026; } elsif ( $y > 2082 ) { my $z = timegm( reverse(@dhms), $m - 1, $y - 84 ); # expunge 29 Feb 2100 return $z < 1456790400 ? $z + $y2054 : $z + $y2054 - 86400; } return ( timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2054 ) - $y1998; } sub _time2string { ## format time specification string my $arg = shift; my $ls31 = int( $arg & 0x7FFFFFFF ); if ( $arg & 0x80000000 ) { if ( $ls31 > $t2082 ) { $ls31 += 86400 unless $ls31 < $t2100; # expunge 29 Feb 2100 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2054 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1984, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } elsif ( $ls31 > $y2026 ) { my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 - $y2026 ) )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms; } my ( $yy, $mm, @dhms ) = reverse( ( gmtime $ls31 )[0 .. 5] ); return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1900, $mm + 1, @dhms; } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name RRSIG typecovered algorithm labels orgttl sigexpiration siginception keytag signame signature'); use Net::DNS::SEC; $sigrr = Net::DNS::RR::RRSIG->create( \@rrset, $keypath, sigex => 20211231010101 sigin => 20211201010101 ); $sigrr->verify( \@rrset, $keyrr ) || die $sigrr->vrfyerrstr; =head1 DESCRIPTION Class for DNS digital signature (RRSIG) resource records. In addition to the regular methods inherited from Net::DNS::RR the class contains a method to sign RRsets using private keys (create) and a method for verifying signatures over RRsets (verify). The RRSIG RR is an implementation of RFC4034. See L<Net::DNS::RR::SIG> for an implementation of SIG0 (RFC2931). =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 typecovered $typecovered = $rr->typecovered; The typecovered field identifies the type of the RRset that is covered by this RRSIG record. =head2 algorithm $algorithm = $rr->algorithm; The algorithm number field identifies the cryptographic algorithm used to create the signature. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 labels $labels = $rr->labels; $rr->labels( $labels ); The labels field specifies the number of labels in the original RRSIG RR owner name. =head2 orgttl $orgttl = $rr->orgttl; $rr->orgttl( $orgttl ); The original TTL field specifies the TTL of the covered RRset as it appears in the authoritative zone. =head2 sigexpiration and siginception times =head2 sigex sigin sigval $expiration = $rr->sigexpiration; $expiration = $rr->sigexpiration( $value ); $inception = $rr->siginception; $inception = $rr->siginception( $value ); The signature expiration and inception fields specify a validity time interval for the signature. The value may be specified by a string with format 'yyyymmddhhmmss' or a Perl time() value. Return values are dual-valued, providing either a string value or numerical Perl time() value. =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); The keytag field contains the key tag value of the DNSKEY RR that validates this signature. =head2 signame $signame = $rr->signame; $rr->signame( $signame ); The signer name field value identifies the owner name of the DNSKEY RR that a validator is supposed to use to validate this signature. =head2 signature =head2 sig $sig = $rr->sig; $rr->sig( $sig ); The Signature field contains the cryptographic signature that covers the RRSIG RDATA (excluding the Signature field) and the RRset specified by the RRSIG owner name, RRSIG class, and RRSIG type covered fields. =head2 sigbin $sigbin = $rr->sigbin; $rr->sigbin( $sigbin ); Binary representation of the cryptographic signature. =head2 create Create a signature over a RR set. use Net::DNS::SEC; $keypath = '/home/olaf/keys/Kbla.foo.+001+60114.private'; $sigrr = Net::DNS::RR::RRSIG->create( \@rrsetref, $keypath ); $sigrr = Net::DNS::RR::RRSIG->create( \@rrsetref, $keypath, sigex => 20211231010101 sigin => 20211201010101 ); $sigrr->print; # Alternatively use Net::DNS::SEC::Private $private = Net::DNS::SEC::Private->new($keypath); $sigrr= Net::DNS::RR::RRSIG->create( \@rrsetref, $private ); create() is an alternative constructor for a RRSIG RR object. This method returns an RRSIG with the signature over the subject rrset (an array of RRs) made with the private key stored in the key file. The first argument is a reference to an array that contains the RRset that needs to be signed. The second argument is a string which specifies the path to a file containing the private key as generated by dnssec-keygen. The optional remaining arguments consist of ( name => value ) pairs as follows: sigex => 20211231010101, # signature expiration sigin => 20211201010101, # signature inception sigval => 30, # validity window (days) ttl => 3600 # TTL The sigin and sigex values may be specified as Perl time values or as a string with the format 'yyyymmddhhmmss'. The default for sigin is the time of signing. The sigval argument specifies the signature validity window in days ( sigex = sigin + sigval ). By default the signature is valid for 30 days. By default the TTL matches the RRset that is presented for signing. =head2 verify $verify = $sigrr->verify( $rrsetref, $keyrr ); $verify = $sigrr->verify( $rrsetref, [$keyrr, $keyrr2, $keyrr3] ); $rrsetref contains a reference to an array of RR objects and the 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 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. Returns 0 on error and sets $sig->vrfyerrstr =head2 vrfyerrstr $verify = $sigrr->verify( $rrsetref, $keyrr ); print $sigrr->vrfyerrstr unless $verify; $sigrr->verify( $rrsetref, $keyrr ) || die $sigrr->vrfyerrstr; =head1 KEY GENERATION Private key files and corresponding public DNSKEY records are most conveniently generated using dnssec-keygen, a program that comes with the ISC BIND distribution. dnssec-keygen -a 10 -b 2048 -f ksk rsa.example. dnssec-keygen -a 10 -b 1024 rsa.example. dnssec-keygen -a 14 -f ksk ecdsa.example. dnssec-keygen -a 14 ecdsa.example. Do not change the name of the private key file. The create method uses the filename as generated by dnssec-keygen to determine the keyowner, algorithm, and the keyid (keytag). =head1 REMARKS The code is not optimised for speed. It is probably not suitable to be used for signing large zones. If this code is still around in 2100 (not a leap year) you will need to check for proper handling of times after 28th February. =head1 ACKNOWLEDGMENTS Although their original code may have disappeared following redesign of Net::DNS, Net::DNS::SEC and the OpenSSL API, the following individual contributors deserve to be recognised for their significant influence on the development of the RRSIG package. Andy Vaskys (Network Associates Laboratories) supplied code for RSA. T.J. Mather provided support for the DSA algorithm. 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 Copyright (c)2001-2005 RIPE NCC, Olaf M. Kolkman Copyright (c)2007-2008 NLnet Labs, Olaf M. Kolkman Portions Copyright (c)2014 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::SEC>, RFC4034 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers> L<BIND Administrator Reference Manual|http://bind.isc.org/> =cut PK ! n�/�Z Z KX.pmnu �[��� package Net::DNS::RR::KX; use strict; use warnings; our $VERSION = (qw$Id: KX.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::KX - DNS KX resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; $self->{preference} = unpack( "\@$offset n", $$data ); $self->{exchange} = Net::DNS::DomainName2535->decode( $data, $offset + 2, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $exchange = $self->{exchange}; return pack 'n a*', $self->preference, $exchange->encode( $offset + 2, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $exchange = $self->{exchange}; return join ' ', $self->preference, $exchange->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->preference(shift); $self->exchange(shift); return; } sub preference { my $self = shift; $self->{preference} = 0 + shift if scalar @_; return $self->{preference} || 0; } sub exchange { my $self = shift; $self->{exchange} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{exchange} ? $self->{exchange}->name : undef; } my $function = sub { ## sort RRs in numerically ascending order. $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'}; }; __PACKAGE__->set_rrsort_func( 'preference', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name KX preference exchange'); =head1 DESCRIPTION DNS Key Exchange Delegation (KX) record =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 preference $preference = $rr->preference; $rr->preference( $preference ); A 16 bit integer which specifies the preference given to this RR among others at the same owner. Lower values are preferred. =head2 exchange $exchange = $rr->exchange; $rr->exchange( $exchange ); A domain name which specifies a host willing to act as a key exchange for the owner name. =head1 COPYRIGHT Copyright (c)2009 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2230 =cut PK ! '�X~QP QP TSIG.pmnu �[��� package Net::DNS::RR::TSIG; use strict; use warnings; our $VERSION = (qw$Id: TSIG.pm 1856 2021-12-02 14:36:25Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::TSIG - DNS TSIG resource record =cut use integer; use Carp; use Net::DNS::DomainName; use Net::DNS::Parameters qw(:class :type :rcode); use constant SYMLINK => defined(&CORE::readlink); # Except Win32, VMS, RISC OS use constant ANY => classbyname q(ANY); use constant TSIG => typebyname q(TSIG); eval { require Digest::HMAC }; eval { require Digest::MD5 }; eval { require Digest::SHA }; eval { require MIME::Base64 }; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; ( $self->{algorithm}, $offset ) = Net::DNS::DomainName->decode(@_); # Design decision: Use 32 bits, which will work until the end of time()! @{$self}{qw(time_signed fudge)} = unpack "\@$offset xxN n", $$data; $offset += 8; my $mac_size = unpack "\@$offset n", $$data; $self->{macbin} = unpack "\@$offset xx a$mac_size", $$data; $offset += $mac_size + 2; @{$self}{qw(original_id error)} = unpack "\@$offset nn", $$data; $offset += 4; my $other_size = unpack "\@$offset n", $$data; $self->{other} = unpack "\@$offset xx a$other_size", $$data; $offset += $other_size + 2; croak('misplaced or corrupt TSIG') unless $limit == length $$data; my $raw = substr $$data, 0, $self->{offset}; $self->{rawref} = \$raw; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $macbin = $self->macbin; unless ($macbin) { my ( $offset, undef, $packet ) = @_; my $sigdata = $self->sig_data($packet); # form data to be signed $macbin = $self->macbin( $self->_mac_function($sigdata) ); $self->original_id( $packet->header->id ); } my $rdata = $self->{algorithm}->canonical; # Design decision: Use 32 bits, which will work until the end of time()! $rdata .= pack 'xxN n', $self->time_signed, $self->fudge; $rdata .= pack 'na*', length($macbin), $macbin; $rdata .= pack 'nn', $self->original_id, $self->{error}; my $other = $self->other; $rdata .= pack 'na*', length($other), $other; return $rdata; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->algorithm(157); $self->class('ANY'); $self->error(0); $self->fudge(300); $self->other(''); return; } sub _size { ## estimate encoded size my $self = shift; my $clone = bless {%$self}, ref($self); # shallow clone return length $clone->encode( 0, undef, Net::DNS::Packet->new() ); } sub encode { ## overide RR method my $self = shift; my $kname = $self->{owner}->encode(); # uncompressed key name my $rdata = eval { $self->_encode_rdata(@_) } || ''; return pack 'a* n2 N n a*', $kname, TSIG, ANY, 0, length $rdata, $rdata; } sub string { ## overide RR method my $self = shift; my $owner = $self->{owner}->string; my $type = $self->type; my $algorithm = $self->algorithm; my $time_signed = $self->time_signed; my $fudge = $self->fudge; my $signature = $self->mac; my $original_id = $self->original_id; my $error = $self->error; my $other = $self->other; return <<"QQ"; ; $owner $type ; algorithm: $algorithm ; time signed: $time_signed fudge: $fudge ; signature: $signature ; original id: $original_id ; $error $other QQ } sub algorithm { return &_algorithm; } sub key { my $self = shift; return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @_; return $self->keybin( MIME::Base64::decode( join "", @_ ) ); } sub keybin { return &_keybin; } sub time_signed { my $self = shift; $self->{time_signed} = 0 + shift if scalar @_; return $self->{time_signed} ? $self->{time_signed} : ( $self->{time_signed} = time() ); } sub fudge { my $self = shift; $self->{fudge} = 0 + shift if scalar @_; return $self->{fudge} || 0; } sub mac { my $self = shift; return MIME::Base64::encode( $self->macbin(), "" ) unless scalar @_; return $self->macbin( MIME::Base64::decode( join "", @_ ) ); } sub macbin { my $self = shift; $self->{macbin} = shift if scalar @_; return $self->{macbin} || ""; } sub prior_mac { my $self = shift; return MIME::Base64::encode( $self->prior_macbin(), "" ) unless scalar @_; return $self->prior_macbin( MIME::Base64::decode( join "", @_ ) ); } sub prior_macbin { my $self = shift; $self->{prior_macbin} = shift if scalar @_; return $self->{prior_macbin} || ""; } sub request_mac { my $self = shift; return MIME::Base64::encode( $self->request_macbin(), "" ) unless scalar @_; return $self->request_macbin( MIME::Base64::decode( join "", @_ ) ); } sub request_macbin { my $self = shift; $self->{request_macbin} = shift if scalar @_; return $self->{request_macbin} || ""; } sub original_id { my $self = shift; $self->{original_id} = 0 + shift if scalar @_; return $self->{original_id} || 0; } sub error { my $self = shift; $self->{error} = rcodebyname(shift) if scalar @_; return rcodebyval( $self->{error} ); } sub other { my $self = shift; $self->{other} = shift if scalar @_; my $time = $self->{error} == 18 ? pack 'xxN', time() : ''; return $self->{other} ? $self->{other} : ( $self->{other} = $time ); } sub other_data { return &other; } # uncoverable pod sub sig_function { my $self = shift; $self->{sig_function} = shift if scalar @_; return $self->{sig_function}; } sub sign_func { return &sig_function; } # uncoverable pod sub sig_data { my ( $self, $message ) = @_; if ( ref($message) ) { die 'missing packet reference' unless $message->isa('Net::DNS::Packet'); my @unsigned = grep { ref($_) ne ref($self) } @{$message->{additional}}; local $message->{additional} = \@unsigned; # remake header image my @part = qw(question answer authority additional); my @size = map { scalar @{$message->{$_}} } @part; if ( my $rawref = $self->{rawref} ) { delete $self->{rawref}; my $hbin = pack 'n6', $self->original_id, $message->{status}, @size; $message = join '', $hbin, substr $$rawref, length $hbin; } else { my $data = $message->data; my $hbin = pack 'n6', $message->{id}, $message->{status}, @size; $message = join '', $hbin, substr $data, length $hbin; } } # Design decision: Use 32 bits, which will work until the end of time()! my $time = pack 'xxN n', $self->time_signed, $self->fudge; # Insert the prior MAC if present (multi-packet message). $self->prior_macbin( $self->{link}->macbin ) if $self->{link}; my $prior_macbin = $self->prior_macbin; return pack 'na* a* a*', length($prior_macbin), $prior_macbin, $message, $time if $prior_macbin; # Insert the request MAC if present (used to validate responses). my $req_mac = $self->request_macbin; my $sigdata = $req_mac ? pack( 'na*', length($req_mac), $req_mac ) : ''; $sigdata .= $message || ''; my $kname = $self->{owner}->canonical; # canonical key name $sigdata .= pack 'a* n N', $kname, ANY, 0; $sigdata .= $self->{algorithm}->canonical; # canonical algorithm name $sigdata .= $time; $sigdata .= pack 'n', $self->{error}; my $other = $self->other; $sigdata .= pack 'na*', length($other), $other; return $sigdata; } sub create { my $class = shift; my $karg = shift; croak 'argument undefined' unless defined $karg; if ( ref($karg) ) { if ( $karg->isa('Net::DNS::Packet') ) { my $sigrr = $karg->sigrr; croak 'no TSIG in request packet' unless defined $sigrr; return Net::DNS::RR->new( # ( request, options ) name => $sigrr->name, type => 'TSIG', algorithm => $sigrr->algorithm, request_macbin => $sigrr->macbin, @_ ); } elsif ( ref($karg) eq __PACKAGE__ ) { my $tsig = $karg->_chain; $tsig->{macbin} = undef; return $tsig; } elsif ( ref($karg) eq 'Net::DNS::RR::KEY' ) { return Net::DNS::RR->new( name => $karg->name, type => 'TSIG', algorithm => $karg->algorithm, key => $karg->key, @_ ); } croak "Usage: $class->create( \$keyfile, \@options )"; } elsif ( scalar(@_) == 1 ) { $class->_deprecate('create( $keyname, $key )'); # ( keyname, key ) return Net::DNS::RR->new( name => $karg, type => 'TSIG', key => shift ); } else { require File::Spec; # ( keyfile, options ) require Net::DNS::ZoneFile; my ($keypath) = SYMLINK ? grep( {$_} readlink($karg), $karg ) : $karg; my ( $vol, $dir, $name ) = File::Spec->splitpath($keypath); $name =~ m/^K([^+]+)\+\d+\+(\d+)\./; # BIND dnssec-keygen my ( $keyname, $keytag ) = ( $1, $2 ); my $keyfile = Net::DNS::ZoneFile->new($karg); my ( $algorithm, $secret, $x ); while ( $keyfile->_getline ) { /^key "([^"]+)"/ and $keyname = $1; # BIND tsig key /algorithm ([^;]+);/ and $algorithm = $1; /secret "([^"]+)";/ and $secret = $1; /^Algorithm:/ and ( $x, $algorithm ) = split; # BIND dnssec private key /^Key:/ and ( $x, $secret ) = split; next unless /\bIN\s+KEY\b/; # BIND dnssec public key my $keyrr = Net::DNS::RR->new($_); carp "$karg does not appear to be a BIND dnssec public key" unless $keytag and ( $keytag == $keyrr->keytag ); return $class->create( $keyrr, @_ ); } foreach ( $keyname, $algorithm, $secret ) { croak 'key file incompatible with TSIG' unless $_; } return Net::DNS::RR->new( name => $keyname, type => 'TSIG', algorithm => $algorithm, key => $secret, @_ ); } } sub verify { my $self = shift; my $data = shift; if ( scalar @_ ) { my $arg = shift; unless ( ref($arg) ) { $self->error(16); # BADSIG (multi-packet) return; } my $signerkey = lc( join '+', $self->name, $self->algorithm ); if ( $arg->isa('Net::DNS::Packet') ) { my $request = $arg->sigrr; # request TSIG my $rqstkey = lc( join '+', $request->name, $request->algorithm ); $self->error(17) unless $signerkey eq $rqstkey; # BADKEY $self->request_macbin( $request->macbin ); } elsif ( $arg->isa(__PACKAGE__) ) { my $priorkey = lc( join '+', $arg->name, $arg->algorithm ); $self->error(17) unless $signerkey eq $priorkey; # BADKEY $self->prior_macbin( $arg->macbin ); } else { croak 'Usage: $tsig->verify( $reply, $query )'; } } return if $self->{error}; my $sigdata = $self->sig_data($data); # form data to be verified my $tsigmac = $self->_mac_function($sigdata); my $tsig = $self->_chain; my $macbin = $self->macbin; my $maclen = length $macbin; my $minlen = length($tsigmac) >> 1; # per RFC4635, 3.1 $self->error(16) if $macbin ne substr $tsigmac, 0, $maclen; # BADSIG $self->error(22) if $maclen < $minlen or $maclen < 10 or $maclen > length $tsigmac; # BADTRUNC $self->error(18) if abs( time() - $self->time_signed ) > $self->fudge; # BADTIME return $self->{error} ? undef : $tsig; } sub vrfyerrstr { my $self = shift; return $self->error; } ######################################## { # source: http://www.iana.org/assignments/tsig-algorithm-names my @algbyname = ( 'HMAC-MD5.SIG-ALG.REG.INT' => 157, # numbers are from ISC BIND keygen 'HMAC-SHA1' => 161, # and not blessed by IANA 'HMAC-SHA224' => 162, 'HMAC-SHA256' => 163, 'HMAC-SHA384' => 164, 'HMAC-SHA512' => 165, ); my @algalias = ( 'HMAC-MD5' => 157, 'HMAC-SHA' => 161, ); my %algbyval = reverse @algbyname; my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname, @algalias; foreach (@algrehash) { s/[\W_]//g; } # strip non-alphanumerics my %algbyname = @algrehash; # work around broken cperl sub _algbyname { my $key = uc shift; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics return $algbyname{$key}; } sub _algbyval { my $value = shift; return $algbyval{$value}; } } { my %digest = ( '157' => ['Digest::MD5'], '161' => ['Digest::SHA'], '162' => ['Digest::SHA', 224, 64], '163' => ['Digest::SHA', 256, 64], '164' => ['Digest::SHA', 384, 128], '165' => ['Digest::SHA', 512, 128], ); my %keytable; sub _algorithm { ## install sig function in key table my $self = shift; if ( my $algname = shift ) { unless ( my $digtype = _algbyname($algname) ) { $self->{algorithm} = Net::DNS::DomainName->new($algname); } else { $algname = _algbyval($digtype); $self->{algorithm} = Net::DNS::DomainName->new($algname); my ( $hash, @param ) = @{$digest{$digtype}}; my ( undef, @block ) = @param; my $digest = $hash->new(@param); my $function = sub { my $hmac = Digest::HMAC->new( shift, $digest, @block ); $hmac->add(shift); return $hmac->digest; }; $self->sig_function($function); my $keyname = ( $self->{owner} || return )->canonical; $keytable{$keyname}{digest} = $function; } } return defined wantarray ? $self->{algorithm}->name : undef; } sub _keybin { ## install key in key table my $self = shift; croak 'Unauthorised access to TSIG key material denied' unless scalar @_; my $keyref = $keytable{$self->{owner}->canonical} ||= {}; my $private = shift; # closure keeps private key private $keyref->{key} = sub { my $function = $keyref->{digest}; return &$function( $private, @_ ); }; return; } sub _mac_function { ## apply keyed hash function to argument my $self = shift; my $owner = $self->{owner}->canonical; $self->algorithm( $self->algorithm ) unless $keytable{$owner}{digest}; my $keyref = $keytable{$owner}; $keyref->{digest} = $self->sig_function unless $keyref->{digest}; my $function = $keyref->{key}; return &$function(@_); } } # _chain() creates a new TSIG object linked to the original # RR, for the purpose of signing multi-message transfers. sub _chain { my $self = shift; $self->{link} = undef; return bless {%$self, link => $self}, ref($self); } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $tsig = Net::DNS::RR::TSIG->create( $keyfile ); $tsig = Net::DNS::RR::TSIG->create( $keyfile, fudge => 300 ); =head1 DESCRIPTION Class for DNS Transaction Signature (TSIG) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); A domain name which specifies the name of the algorithm. =head2 key $rr->key( $key ); Base64 representation of the key material. =head2 keybin $rr->keybin( $keybin ); Binary representation of the key material. =head2 time_signed $time_signed = $rr->time_signed; $rr->time_signed( $time_signed ); Signing time as the number of seconds since 1 Jan 1970 00:00:00 UTC. The default signing time is the current time. =head2 fudge $fudge = $rr->fudge; $rr->fudge( $fudge ); "fudge" represents the permitted error in the signing time. The default fudge is 300 seconds. =head2 mac $rr->mac( $mac ); Message authentication code (MAC). The programmer must call the Net::DNS::Packet data() object method before this will return anything meaningful. =head2 macbin $macbin = $rr->macbin; $rr->macbin( $macbin ); Binary message authentication code (MAC). =head2 prior_mac $prior_mac = $rr->prior_mac; $rr->prior_mac( $prior_mac ); Prior message authentication code (MAC). =head2 prior_macbin $prior_macbin = $rr->prior_macbin; $rr->prior_macbin( $prior_macbin ); Binary prior message authentication code. =head2 request_mac $request_mac = $rr->request_mac; $rr->request_mac( $request_mac ); Request message authentication code (MAC). =head2 request_macbin $request_macbin = $rr->request_macbin; $rr->request_macbin( $request_macbin ); Binary request message authentication code. =head2 original_id $original_id = $rr->original_id; $rr->original_id( $original_id ); The message ID from the header of the original packet. =head2 error =head2 vrfyerrstr $rcode = $tsig->error; Returns the RCODE covering TSIG processing. Common values are NOERROR, BADSIG, BADKEY, and BADTIME. See RFC8945 for details. =head2 other $other = $tsig->other; This field should be empty unless the error is BADTIME, in which case it will contain the server time as the number of seconds since 1 Jan 1970 00:00:00 UTC. =head2 sig_function sub signing_function { my ( $keybin, $data ) = @_; my $hmac = Digest::HMAC->new( $keybin, 'Digest::MD5' ); $hmac->add( $data ); return $hmac->digest; } $tsig->sig_function( \&signing_function ); This sets the signing function to be used for this TSIG record. The default signing function is HMAC-MD5. =head2 sig_data $sigdata = $tsig->sig_data($packet); Returns the packet packed according to RFC8945 in a form for signing. This is only needed if you want to supply an external signing function, such as is needed for TSIG-GSS. =head2 create $tsig = Net::DNS::RR::TSIG->create( $keyfile ); $tsig = Net::DNS::RR::TSIG->create( $keyfile, fudge => 300 ); Returns a TSIG RR constructed using the parameters in the specified key file, which is assumed to have been generated by tsig-keygen. =head2 verify $verify = $tsig->verify( $data ); $verify = $tsig->verify( $packet ); $verify = $tsig->verify( $reply, $query ); $verify = $tsig->verify( $packet, $prior ); The boolean verify method will return true if the hash over the packet data conforms to the data in the TSIG itself =head1 TSIG Keys The TSIG authentication mechanism employs shared secret keys to establish a trust relationship between two entities. It should be noted that it is possible for more than one key to be in use simultaneously between any such pair of entities. TSIG keys are generated using the tsig-keygen utility distributed with ISC BIND: tsig-keygen -a HMAC-SHA256 host1-host2.example. Other algorithms may be substituted for HMAC-SHA256 in the above example. These keys must be protected in a manner similar to private keys, lest a third party masquerade as one of the intended parties by forging the message authentication code (MAC). =head1 Configuring BIND Nameserver The generated key must be added to the /etc/named.conf configuration or a separate file introduced by the $INCLUDE directive: key "host1-host2.example. { algorithm hmac-sha256; secret "Secret+known+only+by+participating+entities="; }; =head1 ACKNOWLEDGMENT Most of the code in the Net::DNS::RR::TSIG module was contributed by Chris Turbeville. Support for external signing functions was added by Andrew Tridgell. TSIG verification, BIND keyfile handling and support for HMAC-SHA1, HMAC-SHA224, HMAC-SHA256, HMAC-SHA384 and HMAC-SHA512 functions was added by Dick Franks. =head1 BUGS A 32-bit representation of time is used, contrary to RFC2845 which demands 48 bits. This design decision will need to be reviewed before the code stops working on 7 February 2106. =head1 COPYRIGHT Copyright (c)2000,2001 Michael Fuhr. Portions Copyright (c)2002,2003 Chris Reinhardt. Portions Copyright (c)2013,2020 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8945 L<TSIG Algorithm Names|http://www.iana.org/assignments/tsig-algorithm-names> =cut PK ! ����C C SOA.pmnu �[��� package Net::DNS::RR::SOA; use strict; use warnings; our $VERSION = (qw$Id: SOA.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SOA - DNS SOA resource record =cut use integer; use Net::DNS::DomainName; use Net::DNS::Mailbox; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; ( $self->{mname}, $offset ) = Net::DNS::DomainName1035->decode(@_); ( $self->{rname}, $offset ) = Net::DNS::Mailbox1035->decode( $data, $offset, @opaque ); @{$self}{qw(serial refresh retry expire minimum)} = unpack "\@$offset N5", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $rname = $self->{rname}; my $rdata = $self->{mname}->encode(@_); $rdata .= $rname->encode( $offset + length($rdata), @opaque ); $rdata .= pack 'N5', $self->serial, @{$self}{qw(refresh retry expire minimum)}; return $rdata; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $mname = $self->{mname}->string; my $rname = $self->{rname}->string; my $serial = $self->serial; my $spacer = length "$serial" > 7 ? "" : "\t"; return ($mname, $rname, join( "\n\t\t\t\t", "\t\t\t$serial$spacer\t;serial", "$self->{refresh}\t\t;refresh", "$self->{retry}\t\t;retry", "$self->{expire}\t\t;expire", "$self->{minimum}\t\t;minimum\n" ) ); } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->mname(shift); $self->rname(shift); $self->serial(shift); for (qw(refresh retry expire minimum)) { $self->$_( Net::DNS::RR::ttl( {}, shift ) ) if scalar @_; } return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata(qw(. . 0 4h 1h 3w 1h)); delete $self->{serial}; return; } sub mname { my $self = shift; $self->{mname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{mname} ? $self->{mname}->name : undef; } sub rname { my $self = shift; $self->{rname} = Net::DNS::Mailbox1035->new(shift) if scalar @_; return $self->{rname} ? $self->{rname}->address : undef; } sub serial { my $self = shift; return $self->{serial} || 0 unless scalar @_; # current/default value my $value = shift; # replace if in sequence return $self->{serial} = ( $value & 0xFFFFFFFF ) if _ordered( $self->{serial}, $value ); # unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished my $serial = 0xFFFFFFFF & ( $self->{serial} || 0 ); return $self->{serial} = 0x80000000 if $serial == 0x7FFFFFFF; # wrap return $self->{serial} = 0x00000000 if $serial == 0xFFFFFFFF; # wrap return $self->{serial} = $serial + 1; # increment } sub refresh { my $self = shift; $self->{refresh} = 0 + shift if scalar @_; return $self->{refresh} || 0; } sub retry { my $self = shift; $self->{retry} = 0 + shift if scalar @_; return $self->{retry} || 0; } sub expire { my $self = shift; $self->{expire} = 0 + shift if scalar @_; return $self->{expire} || 0; } sub minimum { my $self = shift; $self->{minimum} = 0 + shift if scalar @_; return $self->{minimum} || 0; } ######################################## sub _ordered() { ## irreflexive 32-bit partial ordering use integer; my ( $n1, $n2 ) = @_; return 0 unless defined $n2; # ( any, undef ) return 1 unless defined $n1; # ( undef, any ) # unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished if ( $n2 < 0 ) { # fold, leaving $n2 non-negative $n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000; # -2**31 <= $n1 < 2**32 $n2 = ( $n2 & 0x7FFFFFFF ); # 0 <= $n2 < 2**31 } return $n1 < $n2 ? ( $n1 > ( $n2 - 0x80000000 ) ) : ( $n2 < ( $n1 - 0x80000000 ) ); } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name SOA mname rname 0 14400 3600 1814400 3600'); =head1 DESCRIPTION Class for DNS Start of Authority (SOA) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 mname $mname = $rr->mname; $rr->mname( $mname ); The domain name of the name server that was the original or primary source of data for this zone. =head2 rname $rname = $rr->rname; $rr->rname( $rname ); The mailbox which identifies the person responsible for maintaining this zone. =head2 serial $serial = $rr->serial; $serial = $rr->serial(value); Unsigned 32 bit version number of the original copy of the zone. Zone transfers preserve this value. RFC1982 defines a strict (irreflexive) partial ordering for zone serial numbers. The serial number will be incremented unless the replacement value argument satisfies the ordering constraint. =head2 refresh $refresh = $rr->refresh; $rr->refresh( $refresh ); A 32 bit time interval before the zone should be refreshed. =head2 retry $retry = $rr->retry; $rr->retry( $retry ); A 32 bit time interval that should elapse before a failed refresh should be retried. =head2 expire $expire = $rr->expire; $rr->expire( $expire ); A 32 bit time value that specifies the upper limit on the time interval that can elapse before the zone is no longer authoritative. =head2 minimum $minimum = $rr->minimum; $rr->minimum( $minimum ); The unsigned 32 bit minimum TTL field that should be exported with any RR from this zone. =head1 Zone Serial Number Management The internal logic of the serial() method offers support for several widely used zone serial numbering policies. =head2 Strictly Sequential $successor = $soa->serial( SEQUENTIAL ); The existing serial number is incremented modulo 2**32 because the value returned by the auxilliary SEQUENTIAL() function can never satisfy the serial number ordering constraint. =head2 Date Encoded $successor = $soa->serial( YYYYMMDDxx ); The 32 bit value returned by the auxilliary YYYYMMDDxx() function will be used if it satisfies the ordering constraint, otherwise the serial number will be incremented as above. Serial number increments must be limited to 100 per day for the date information to remain useful. =head2 Time Encoded $successor = $soa->serial( UNIXTIME ); The 32 bit value returned by the auxilliary UNIXTIME() function will used if it satisfies the ordering constraint, otherwise the existing serial number will be incremented as above. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2003 Chris Reinhardt. Portions Copyright (c)2010,2012 Dick Franks. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.13, RFC1982 =cut PK ! J-tW� � CDS.pmnu �[��� package Net::DNS::RR::CDS; use strict; use warnings; our $VERSION = (qw$Id: CDS.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR::DS); =head1 NAME Net::DNS::RR::CDS - DNS CDS resource record =cut use integer; sub algorithm { my ( $self, $arg ) = @_; return $self->SUPER::algorithm($arg) if $arg; return $self->SUPER::algorithm() unless defined $arg; @{$self}{qw(keytag algorithm digtype)} = ( 0, 0, 0 ); return; } sub digtype { my ( $self, $arg ) = @_; return $self->SUPER::digtype( $arg ? $arg : () ); } sub digest { my $self = shift; return $self->SUPER::digest(@_) unless defined( $_[0] ) && length( $_[0] ) < 2; return $self->SUPER::digestbin( $_[0] ? '' : chr(0) ); } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name CDS keytag algorithm digtype digest'); =head1 DESCRIPTION DNS Child DS resource record This is a clone of the DS record and inherits all properties of the Net::DNS::RR::DS class. Please see the L<Net::DNS::RR::DS> perl documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2014,2017 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::DS>, RFC7344, RFC8078(erratum 5049) =cut PK ! �kyw w SRV.pmnu �[��� package Net::DNS::RR::SRV; use strict; use warnings; our $VERSION = (qw$Id: SRV.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::SRV - DNS SRV resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset, @opaque ) = @_; @{$self}{qw(priority weight port)} = unpack( "\@$offset n3", $$data ); $self->{target} = Net::DNS::DomainName2535->decode( $data, $offset + 6, @opaque ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my ( $offset, @opaque ) = @_; my $target = $self->{target}; my @nums = ( $self->priority, $self->weight, $self->port ); return pack 'n3 a*', @nums, $target->encode( $offset + 6, @opaque ); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $target = $self->{target}; my @rdata = ( $self->priority, $self->weight, $self->port, $target->string ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; foreach my $attr (qw(priority weight port target)) { $self->$attr(shift); } return; } sub priority { my $self = shift; $self->{priority} = 0 + shift if scalar @_; return $self->{priority} || 0; } sub weight { my $self = shift; $self->{weight} = 0 + shift if scalar @_; return $self->{weight} || 0; } sub port { my $self = shift; $self->{port} = 0 + shift if scalar @_; return $self->{port} || 0; } sub target { my $self = shift; $self->{target} = Net::DNS::DomainName2535->new(shift) if scalar @_; return $self->{target} ? $self->{target}->name : undef; } # order RRs by numerically increasing priority, decreasing weight my $function = sub { my ( $a, $b ) = ( $Net::DNS::a, $Net::DNS::b ); return $a->{priority} <=> $b->{priority} || $b->{weight} <=> $a->{weight}; }; __PACKAGE__->set_rrsort_func( 'priority', $function ); __PACKAGE__->set_rrsort_func( 'default_sort', $function ); 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name SRV priority weight port target'); =head1 DESCRIPTION Class for DNS Service (SRV) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 priority $priority = $rr->priority; $rr->priority( $priority ); Returns the priority for this target host. =head2 weight $weight = $rr->weight; $rr->weight( $weight ); Returns the weight for this target host. =head2 port $port = $rr->port; $rr->port( $port ); Returns the port number for the service on this target host. =head2 target $target = $rr->target; $rr->target( $target ); Returns the domain name of the target host. =head1 Sorting of SRV Records By default, rrsort() returns the SRV records sorted from lowest to highest priority and for equal priorities from highest to lowest weight. Note: This is NOT the order in which connections should be attempted. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. Portions Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC2782 =cut PK ! �z��g g NS.pmnu �[��� package Net::DNS::RR::NS; use strict; use warnings; our $VERSION = (qw$Id: NS.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NS - DNS NS resource record =cut use integer; use Net::DNS::DomainName; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; $self->{nsdname} = Net::DNS::DomainName1035->decode(@_); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $nsdname = $self->{nsdname}; return $nsdname->encode(@_); } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my $nsdname = $self->{nsdname}; return $nsdname->string; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->nsdname(shift); return; } sub nsdname { my $self = shift; $self->{nsdname} = Net::DNS::DomainName1035->new(shift) if scalar @_; return $self->{nsdname} ? $self->{nsdname}->name : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name NS nsdname'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'NS', nsdname => 'ns.example.com', ); =head1 DESCRIPTION Class for DNS Name Server (NS) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 nsdname $nsdname = $rr->nsdname; $rr->nsdname( $nsdname ); A domain name which specifies a host which should be authoritative for the specified class and domain. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.11 =cut PK ! Ǝ�;h h CAA.pmnu �[��� package Net::DNS::RR::CAA; use strict; use warnings; our $VERSION = (qw$Id: CAA.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CAA - DNS CAA resource record =cut use integer; use Net::DNS::Text; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; $self->{flags} = unpack "\@$offset C", $$data; ( $self->{tag}, $offset ) = Net::DNS::Text->decode( $data, $offset + 1 ); $self->{value} = Net::DNS::Text->decode( $data, $offset, $limit - $offset ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'C a* a*', $self->flags, $self->{tag}->encode, $self->{value}->raw; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = ( $self->flags, $self->{tag}->string, $self->{value}->string ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->flags(shift); $self->tag( lc shift ); $self->value(shift); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->flags(0); return; } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; return $self->{flags} || 0; } sub critical { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x0080 | ( $_ || 0 ); $_ ^= 0x0080 unless shift; } } return 0x0080 & ( $self->{flags} || 0 ); } sub tag { my $self = shift; $self->{tag} = Net::DNS::Text->new(shift) if scalar @_; return $self->{tag} ? $self->{tag}->value : undef; } sub value { my $self = shift; $self->{value} = Net::DNS::Text->new(shift) if scalar @_; return $self->{value} ? $self->{value}->value : undef; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN CAA flags tag value'); =head1 DESCRIPTION Class for Certification Authority Authorization (CAA) DNS resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); Unsigned 8-bit number representing Boolean flags. =over 4 =item critical $rr->critical(1); if ( $rr->critical ) { ... } Issuer critical flag. =back =head2 tag $tag = $rr->tag; $rr->tag( $tag ); The property identifier, a sequence of ASCII characters. Tag values may contain ASCII characters a-z, hyphen and 0-9. Tag values should not contain any other characters. Matching of tag values is not case sensitive. =head2 value $value = $rr->value; $rr->value( $value ); A sequence of octets representing the property value. Property values are encoded as binary values and may employ sub-formats. =head1 COPYRIGHT Copyright (c)2013,2015 Dick Franks All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC8659 =cut PK ! ��vA� � A.pmnu �[��� package Net::DNS::RR::A; use strict; use warnings; our $VERSION = (qw$Id: A.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::A - DNS A resource record =cut use integer; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; $self->{address} = unpack "\@$offset a4", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack 'a4', $self->{address}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return $self->address; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->address(shift); return; } my $pad = pack 'x4'; sub address { my ( $self, $addr ) = @_; return join '.', unpack 'C4', $self->{address} . $pad unless defined $addr; # Note: pack masks overlarge values, mostly without warning my @part = split /\./, $addr; my $last = pop(@part); return $self->{address} = pack 'C4', @part, (0) x ( 3 - @part ), $last; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN A address'); $rr = Net::DNS::RR->new( name => 'example.com', type => 'A', address => '192.0.2.1' ); =head1 DESCRIPTION Class for DNS Address (A) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 address $IPv4_address = $rr->address; $rr->address( $IPv4_address ); Version 4 IP address represented using dotted-quad notation. =head1 COPYRIGHT Copyright (c)1997 Michael Fuhr. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.4.1 =cut PK ! �|� � � CERT.pmnu �[��� package Net::DNS::RR::CERT; use strict; use warnings; our $VERSION = (qw$Id: CERT.pm 1856 2021-12-02 14:36:25Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::CERT - DNS CERT resource record =cut use integer; use Carp; use MIME::Base64; my %certtype = ( PKIX => 1, # X.509 as per PKIX SPKI => 2, # SPKI certificate PGP => 3, # OpenPGP packet IPKIX => 4, # The URL of an X.509 data object ISPKI => 5, # The URL of an SPKI certificate IPGP => 6, # The fingerprint and URL of an OpenPGP packet ACPKIX => 7, # Attribute Certificate IACPKIX => 8, # The URL of an Attribute Certificate URI => 253, # URI private OID => 254, # OID private ); sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; @{$self}{qw(certtype keytag algorithm)} = unpack "\@$offset n2 C", $$data; $self->{certbin} = substr $$data, $offset + 5, $self->{rdlength} - 5; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; return pack "n2 C a*", $self->certtype, $self->keytag, $self->algorithm, $self->{certbin}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @param = ( $self->certtype, $self->keytag, $self->algorithm ); my @rdata = ( @param, split /\s+/, encode_base64( $self->{certbin} ) ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->certtype(shift); $self->keytag(shift); $self->algorithm(shift); $self->cert(@_); return; } sub certtype { my $self = shift; return $self->{certtype} unless scalar @_; my $certtype = shift || 0; return $self->{certtype} = $certtype unless $certtype =~ /\D/; my $typenum = $certtype{$certtype}; $typenum || croak qq[unknown certtype $certtype]; return $self->{certtype} = $typenum; } sub keytag { my $self = shift; $self->{keytag} = 0 + shift if scalar @_; return $self->{keytag} || 0; } sub algorithm { my ( $self, $arg ) = @_; return $self->{algorithm} unless defined $arg; return _algbyval( $self->{algorithm} ) if uc($arg) eq 'MNEMONIC'; return $self->{algorithm} = _algbyname($arg); } sub certificate { return &certbin; } sub certbin { my $self = shift; $self->{certbin} = shift if scalar @_; return $self->{certbin} || ""; } sub cert { my $self = shift; return MIME::Base64::encode( $self->certbin(), "" ) unless scalar @_; return $self->certbin( MIME::Base64::decode( join "", @_ ) ); } sub format { return &certtype; } # uncoverable pod sub tag { return &keytag; } # uncoverable pod ######################################## { my @algbyname = ( 'DELETE' => 0, # [RFC4034][RFC4398][RFC8078] 'RSAMD5' => 1, # [RFC3110][RFC4034] 'DH' => 2, # [RFC2539] 'DSA' => 3, # [RFC3755][RFC2536] ## Reserved => 4, # [RFC6725] 'RSASHA1' => 5, # [RFC3110][RFC4034] 'DSA-NSEC3-SHA1' => 6, # [RFC5155] 'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155] 'RSASHA256' => 8, # [RFC5702] ## Reserved => 9, # [RFC6725] 'RSASHA512' => 10, # [RFC5702] ## Reserved => 11, # [RFC6725] 'ECC-GOST' => 12, # [RFC5933] 'ECDSAP256SHA256' => 13, # [RFC6605] 'ECDSAP384SHA384' => 14, # [RFC6605] 'ED25519' => 15, # [RFC8080] 'ED448' => 16, # [RFC8080] 'INDIRECT' => 252, # [RFC4034] 'PRIVATEDNS' => 253, # [RFC4034] 'PRIVATEOID' => 254, # [RFC4034] ## Reserved => 255, # [RFC4034] ); my %algbyval = reverse @algbyname; foreach (@algbyname) { s/[\W_]//g; } # strip non-alphanumerics my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname; my %algbyname = @algrehash; # work around broken cperl sub _algbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $algbyname{$key}; return $val if defined $val; return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg]; } sub _algbyval { my $value = shift; return $algbyval{$value} || return $value; } } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name IN CERT certtype keytag algorithm cert'); =head1 DESCRIPTION Class for DNS Certificate (CERT) resource records. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 certtype $certtype = $rr->certtype; Returns the certtype code for the certificate (in numeric form). =head2 keytag $keytag = $rr->keytag; $rr->keytag( $keytag ); Returns the key tag for the public key in the certificate =head2 algorithm $algorithm = $rr->algorithm; Returns the algorithm used by the certificate (in numeric form). =head2 certificate =head2 certbin $certbin = $rr->certbin; $rr->certbin( $certbin ); Binary representation of the certificate. =head2 cert $cert = $rr->cert; $rr->cert( $cert ); Base64 representation of the certificate. =head1 COPYRIGHT Copyright (c)2002 VeriSign, Mike Schiraldi All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC4398 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers> =cut PK ! ����7 7 NSEC3PARAM.pmnu �[��� package Net::DNS::RR::NSEC3PARAM; use strict; use warnings; our $VERSION = (qw$Id: NSEC3PARAM.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR); =head1 NAME Net::DNS::RR::NSEC3PARAM - DNS NSEC3PARAM resource record =cut use integer; use Carp; sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $size = unpack "\@$offset x4 C", $$data; @{$self}{qw(algorithm flags iterations saltbin)} = unpack "\@$offset CCnx a$size", $$data; return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $salt = $self->saltbin; return pack 'CCnCa*', @{$self}{qw(algorithm flags iterations)}, length($salt), $salt; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; return join ' ', $self->algorithm, $self->flags, $self->iterations, $self->salt || '-'; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; $self->algorithm(shift); $self->flags(shift); $self->iterations(shift); my $salt = shift; $self->salt($salt) unless $salt eq '-'; return; } sub algorithm { my $self = shift; $self->{algorithm} = 0 + shift if scalar @_; return $self->{algorithm} || 0; } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; return $self->{flags} || 0; } sub iterations { my $self = shift; $self->{iterations} = 0 + shift if scalar @_; return $self->{iterations} || 0; } sub salt { my $self = shift; return unpack "H*", $self->saltbin() unless scalar @_; return $self->saltbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub saltbin { my $self = shift; $self->{saltbin} = shift if scalar @_; return $self->{saltbin} || ""; } ######################################## sub hashalgo { return &algorithm; } # uncoverable pod ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name NSEC3PARAM algorithm flags iterations salt'); =head1 DESCRIPTION Class for DNSSEC NSEC3PARAM resource records. The NSEC3PARAM RR contains the NSEC3 parameters (hash algorithm, flags, iterations and salt) needed to calculate hashed ownernames. The presence of an NSEC3PARAM RR at a zone apex indicates that the specified parameters may be used by authoritative servers to choose an appropriate set of NSEC3 records for negative responses. The NSEC3PARAM RR is not used by validators or resolvers. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The Hash Algorithm field is represented as an unsigned decimal integer. The value has a maximum of 255. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); The Flags field is represented as an unsigned decimal integer. The value has a maximum of 255. =head2 iterations $iterations = $rr->iterations; $rr->iterations( $iterations ); The Iterations field is represented as an unsigned decimal integer. The value is between 0 and 65535, inclusive. =head2 salt $salt = $rr->salt; $rr->salt( $salt ); The Salt field is represented as a contiguous sequence of hexadecimal digits. A "-" (unquoted) is used in string format to indicate that the salt field is absent. =head2 saltbin $saltbin = $rr->saltbin; $rr->saltbin( $saltbin ); The Salt field as a sequence of octets. =head1 COPYRIGHT Copyright (c)2007,2008 NLnet Labs. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC5155 =cut PK ! ?�[ KEY.pmnu �[��� package Net::DNS::RR::KEY; use strict; use warnings; our $VERSION = (qw$Id: KEY.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR::DNSKEY); =head1 NAME Net::DNS::RR::KEY - DNS KEY resource record =cut sub _defaults { ## specify RR attribute default values my $self = shift; $self->algorithm(1); $self->flags(0); $self->protocol(3); return; } 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name KEY flags protocol algorithm publickey'); =head1 DESCRIPTION DNS KEY resource record This is a clone of the DNSKEY record and inherits all properties of the Net::DNS::RR::DNSKEY class. Please see the L<Net::DNS::RR::DNSKEY> documentation for details. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head1 COPYRIGHT Copyright (c)2005 Olaf Kolkman, NLnet Labs. All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, L<Net::DNS::RR::DNSKEY>, RFC4034, RFC3755, RFC3008, RFC2535 L<Algorithm Numbers|http://www.iana.org/assignments/dns-sec-alg-numbers> =cut PK ! � �K1 K1 NSEC3.pmnu �[��� package Net::DNS::RR::NSEC3; use strict; use warnings; our $VERSION = (qw$Id: NSEC3.pm 1857 2021-12-07 13:38:02Z willem $)[2]; use base qw(Net::DNS::RR::NSEC); =head1 NAME Net::DNS::RR::NSEC3 - DNS NSEC3 resource record =cut use integer; use base qw(Exporter); our @EXPORT_OK = qw(name2hash); use Carp; require Net::DNS::DomainName; eval { require Digest::SHA }; ## optional for simple Net::DNS RR sub _decode_rdata { ## decode rdata from wire-format octet string my $self = shift; my ( $data, $offset ) = @_; my $limit = $offset + $self->{rdlength}; my $ssize = unpack "\@$offset x4 C", $$data; my ( $algorithm, $flags, $iterations, $saltbin ) = unpack "\@$offset CCnx a$ssize", $$data; @{$self}{qw(algorithm flags iterations saltbin)} = ( $algorithm, $flags, $iterations, $saltbin ); $offset += 5 + $ssize; my $hsize = unpack "\@$offset C", $$data; $self->{hnxtname} = unpack "\@$offset x a$hsize", $$data; $offset += 1 + $hsize; $self->{typebm} = substr $$data, $offset, ( $limit - $offset ); $self->{hashfn} = _hashfn( $algorithm, $iterations, $saltbin ); return; } sub _encode_rdata { ## encode rdata as wire-format octet string my $self = shift; my $salt = $self->saltbin; my $hash = $self->{hnxtname}; return pack 'CCn C a* C a* a*', $self->algorithm, $self->flags, $self->iterations, length($salt), $salt, length($hash), $hash, $self->{typebm}; } sub _format_rdata { ## format rdata portion of RR string. my $self = shift; my @rdata = ( $self->algorithm, $self->flags, $self->iterations, $self->salt || '-', $self->hnxtname, $self->typelist ); return @rdata; } sub _parse_rdata { ## populate RR from rdata in argument list my $self = shift; my $alg = $self->algorithm(shift); $self->flags(shift); my $iter = $self->iterations(shift); my $salt = shift; $self->salt($salt) unless $salt eq '-'; $self->hnxtname(shift); $self->typelist(@_); $self->{hashfn} = _hashfn( $alg, $iter, $self->{saltbin} ); return; } sub _defaults { ## specify RR attribute default values my $self = shift; $self->_parse_rdata( 1, 0, 0, '' ); return; } sub algorithm { my ( $self, $arg ) = @_; unless ( ref($self) ) { ## class method or simple function my $argn = pop; return $argn =~ /[^0-9]/ ? _digestbyname($argn) : _digestbyval($argn); } return $self->{algorithm} unless defined $arg; return _digestbyval( $self->{algorithm} ) if $arg =~ /MNEMONIC/i; return $self->{algorithm} = _digestbyname($arg); } sub flags { my $self = shift; $self->{flags} = 0 + shift if scalar @_; return $self->{flags} || 0; } sub optout { my $self = shift; if ( scalar @_ ) { for ( $self->{flags} ) { $_ = 0x01 | ( $_ || 0 ); $_ ^= 0x01 unless shift; } } return 0x01 & ( $self->{flags} || 0 ); } sub iterations { my $self = shift; $self->{iterations} = 0 + shift if scalar @_; return $self->{iterations} || 0; } sub salt { my $self = shift; return unpack "H*", $self->saltbin() unless scalar @_; return $self->saltbin( pack "H*", join "", map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @_ ); } sub saltbin { my $self = shift; $self->{saltbin} = shift if scalar @_; return $self->{saltbin} || ""; } sub hnxtname { my $self = shift; $self->{hnxtname} = _decode_base32hex(shift) if scalar @_; return defined(wantarray) ? _encode_base32hex( $self->{hnxtname} ) : undef; } sub match { my ( $self, $name ) = @_; my ($owner) = $self->{owner}->label; my $ownerhash = _decode_base32hex($owner); my $hashfn = $self->{hashfn}; return $ownerhash eq &$hashfn($name); } sub covers { my ( $self, $name ) = @_; my ( $owner, @zone ) = $self->{owner}->label; my $ownerhash = _decode_base32hex($owner); my $nexthash = $self->{hnxtname}; my @label = Net::DNS::DomainName->new($name)->label; my @close = @label; foreach (@zone) { pop(@close) } # strip zone labels return if lc($name) ne lc( join '.', @close, @zone ); # out of zone my $hashfn = $self->{hashfn}; foreach (@close) { my $hash = &$hashfn( join '.', @label ); my $cmp1 = $hash cmp $ownerhash; last unless $cmp1; # stop at provable encloser return 1 if ( $cmp1 + ( $nexthash cmp $hash ) ) == 2; shift @label; } return; } sub encloser { my ( $self, $qname ) = @_; my ( $owner, @zone ) = $self->{owner}->label; my $ownerhash = _decode_base32hex($owner); my $nexthash = $self->{hnxtname}; my @label = Net::DNS::DomainName->new($qname)->label; my @close = @label; foreach (@zone) { pop(@close) } # strip zone labels return if lc($qname) ne lc( join '.', @close, @zone ); # out of zone my $hashfn = $self->{hashfn}; my $encloser = $qname; foreach (@close) { my $nextcloser = $encloser; shift @label; my $hash = &$hashfn( $encloser = join '.', @label ); next if $hash ne $ownerhash; $self->{nextcloser} = $nextcloser; # next closer name $self->{wildcard} = "*.$encloser"; # wildcard at provable encloser return $encloser; # provable encloser } return; } sub nextcloser { return shift->{nextcloser}; } sub wildcard { return shift->{wildcard}; } ######################################## my @digestbyname = ( 'SHA-1' => 1, # [RFC3658] ); my @digestalias = ( 'SHA' => 1 ); my %digestbyval = reverse @digestbyname; foreach (@digestbyname) { s/[\W_]//g; } # strip non-alphanumerics my @digestrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @digestbyname; my %digestbyname = ( @digestalias, @digestrehash ); # work around broken cperl sub _digestbyname { my $arg = shift; my $key = uc $arg; # synthetic key $key =~ s/[\W_]//g; # strip non-alphanumerics my $val = $digestbyname{$key}; croak qq[unknown algorithm $arg] unless defined $val; return $val; } sub _digestbyval { my $value = shift; return $digestbyval{$value} || return $value; } my %digest = ( '1' => scalar( eval { Digest::SHA->new(1) } ), # RFC3658 ); sub _decode_base32hex { local $_ = shift || ''; tr [0-9A-Va-v\060-\071\101-\126\141-\166] [\000-\037\012-\037\000-\037\012-\037]; my $l = ( 5 * length ) & ~7; return pack "B$l", join '', map { unpack( 'x3a5', unpack 'B8', $_ ) } split //; } sub _encode_base32hex { my @split = grep {length} split /(\S{5})/, unpack 'B*', shift; local $_ = join '', map { pack( 'B*', "000$_" ) } @split; tr [\000-\037] [0-9a-v]; return $_; } my ( $cache1, $cache2, $limit ) = ( {}, {}, 10 ); sub _hashfn { my $hashalg = shift; my $iterations = shift || 0; my $salt = shift || ''; my $hash = $digest{$hashalg}; return sub { croak "algorithm $hashalg not supported" } unless $hash; my $clone = $hash->clone; my $key_adjunct = pack 'Cna*', $hashalg, $iterations, $salt; return sub { my $name = Net::DNS::DomainName->new(shift)->canonical; my $key = join '', $name, $key_adjunct; my $cache = $$cache1{$key} ||= $$cache2{$key}; # two layer cache return $cache if defined $cache; ( $cache1, $cache2, $limit ) = ( {}, $cache1, 50 ) unless $limit--; # recycle cache $clone->add($name); $clone->add($salt); my $digest = $clone->digest; my $count = $iterations; while ( $count-- ) { $clone->add($digest); $clone->add($salt); $digest = $clone->digest; } return $$cache1{$key} = $digest; }; } sub hashalgo { return &algorithm; } # uncoverable pod sub name2hash { my $hashalg = shift; # uncoverable pod my $name = shift; my $iterations = shift || 0; my $salt = pack 'H*', shift || ''; my $hash = _hashfn( $hashalg, $iterations, $salt ); return _encode_base32hex( &$hash($name) ); } ######################################## 1; __END__ =head1 SYNOPSIS use Net::DNS; $rr = Net::DNS::RR->new('name NSEC3 algorithm flags iterations salt hnxtname'); =head1 DESCRIPTION Class for DNSSEC NSEC3 resource records. The NSEC3 Resource Record (RR) provides authenticated denial of existence for DNS Resource Record Sets. The NSEC3 RR lists RR types present at the original owner name of the NSEC3 RR. It includes the next hashed owner name in the hash order of the zone. The complete set of NSEC3 RRs in a zone indicates which RRSets exist for the original owner name of the RR and form a chain of hashed owner names in the zone. =head1 METHODS The available methods are those inherited from the base class augmented by the type-specific methods defined in this package. Use of undocumented package features or direct access to internal data structures is discouraged and could result in program termination or other unpredictable behaviour. =head2 algorithm $algorithm = $rr->algorithm; $rr->algorithm( $algorithm ); The Hash Algorithm field is represented as an unsigned decimal integer. The value has a maximum of 255. algorithm() may also be invoked as a class method or simple function to perform mnemonic and numeric code translation. =head2 flags $flags = $rr->flags; $rr->flags( $flags ); The Flags field is an unsigned decimal integer interpreted as eight concatenated Boolean values. =over 4 =item optout $rr->optout(1); if ( $rr->optout ) { ... } Boolean Opt Out flag. =back =head2 iterations $iterations = $rr->iterations; $rr->iterations( $iterations ); The Iterations field is represented as an unsigned decimal integer. The value is between 0 and 65535, inclusive. =head2 salt $salt = $rr->salt; $rr->salt( $salt ); The Salt field is represented as a contiguous sequence of hexadecimal digits. A "-" (unquoted) is used in string format to indicate that the salt field is absent. =head2 saltbin $saltbin = $rr->saltbin; $rr->saltbin( $saltbin ); The Salt field as a sequence of octets. =head2 hnxtname $hnxtname = $rr->hnxtname; $rr->hnxtname( $hnxtname ); The Next Hashed Owner Name field points to the next node that has authoritative data or contains a delegation point NS RRset. =head2 typelist @typelist = $rr->typelist; $typelist = $rr->typelist; $rr->typelist( @typelist ); typelist() identifies the RRset types that exist at the domain name matched by the NSEC3 RR. When called in scalar context, the list is interpolated into a string. =head2 typemap $exists = $rr->typemap($rrtype); typemap() returns a Boolean true value if the specified RRtype occurs in the type bitmap of the NSEC3 record. =head2 match $matched = $rr->match( 'example.foo' ); match() returns a Boolean true value if the hash of the domain name argument matches the hashed owner name of the NSEC3 RR. =head2 covers $covered = $rr->covers( 'example.foo' ); covers() returns a Boolean true value if the hash of the domain name argument, or ancestor of that name, falls between the owner name and the next hashed owner name of the NSEC3 RR. =head2 encloser, nextcloser, wildcard $encloser = $rr->encloser( 'example.foo' ); print "encloser: $encloser\n" if $encloser; encloser() returns the name of a provable encloser of the query name argument obtained from the NSEC3 RR. nextcloser() returns the next closer name, which is one label longer than the closest encloser. This is only valid after encloser() has returned a valid domain name. wildcard() returns the unexpanded wildcard name from which the next closer name was possibly synthesised. This is only valid after encloser() has returned a valid domain name. =head1 COPYRIGHT Copyright (c)2017,2018 Dick Franks Portions Copyright (c)2007,2008 NLnet Labs. Author Olaf M. Kolkman All rights reserved. Package template (c)2009,2012 O.M.Kolkman and R.W.Franks. =head1 LICENSE Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the original copyright notices appear in all copies and that both copyright notice and this permission notice appear in supporting documentation, and that the name of the author not be used in advertising or publicity pertaining to distribution of the software without specific prior written permission. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 SEE ALSO L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC5155, RFC9077 L<Hash Algorithms|http://www.iana.org/assignments/dnssec-nsec3-parameters> =cut PK ! ƅ�_� � EUI48.pmnu �[��� PK ! ��a a � AFSDB.pmnu �[��� PK ! +�V� 6 6 n OPT.pmnu �[��� PK ! ���� � �P PTR.pmnu �[��� PK ! e_�/ �[ DHCID.pmnu �[��� PK ! 3�e�! ! #o NULL.pmnu �[��� PK ! +���� � {w AAAA.pmnu �[��� PK ! ]��B B b� AMTRELAY.pmnu �[��� PK ! Q��Z ߠ MR.pmnu �[��� PK ! ]/�!4 4 � X25.pmnu �[��� PK ! �X�~ �� L64.pmnu �[��� PK ! ch�S� � �� L32.pmnu �[��� PK ! yO�� � � RT.pmnu �[��� PK ! �V V � SIG.pmnu �[��� PK ! ��� f; HINFO.pmnu �[��� PK ! �y�+k k �G ZONEMD.pmnu �[��� PK ! ���{ { LY NID.pmnu �[��� PK ! iA�b� � �h SMIMEA.pmnu �[��� PK ! ��Q� �} LP.pmnu �[��� PK ! ;�x5� � � IPSECKEY.pmnu �[��� PK ! �G,<) <) � DS.pmnu �[��� PK ! ���o o ^� MINFO.pmnu �[��� PK ! <j�4� � � SSHFP.pmnu �[��� PK ! �[��H$ H$ � DNSKEY.pmnu �[��� PK ! � �� � Y CSYNC.pmnu �[��� PK ! �Ӏ�} } , ISDN.pmnu �[��� PK ! ���� �9 GPOS.pmnu �[��� PK ! =)�5 K MG.pmnu �[��� PK ! �� � � OV CNAME.pmnu �[��� PK ! �.� b NAPTR.pmnu �[��� PK ! f. �� � Zy TKEY.pmnu �[��� PK ! �r��� � u� LOC.pmnu �[��� PK ! �ZӠ� � �� TXT.pmnu �[��� PK ! �4�l l �� RP.pmnu �[��� PK ! 2$D W� HTTPS.pmnu �[��� PK ! �n>�* * �� SVCB.pmnu �[��� PK ! �2�9� � � PX.pmnu �[��� PK ! 6��| OPENPGPKEY.pmnu �[��� PK ! �X/� � b APL.pmnu �[��� PK ! ��w � � ;6 TLSA.pmnu �[��� PK ! ����� � [K HIP.pmnu �[��� PK ! lXL3� � l` CDNSKEY.pmnu �[��� PK ! ��r?� � cj MB.pmnu �[��� PK ! KxW � � �u URI.pmnu �[��� PK ! `� �� MX.pmnu �[��� PK ! >���> > ͕ DNAME.pmnu �[��� PK ! �?�� � C� EUI64.pmnu �[��� PK ! ��� ( ( "� NSEC.pmnu �[��� PK ! ���� � �� SPF.pmnu �[��� PK ! �rCl�] �] G� RRSIG.pmnu �[��� PK ! n�/�Z Z s6 KX.pmnu �[��� PK ! '�X~QP QP E TSIG.pmnu �[��� PK ! ����C C �� SOA.pmnu �[��� PK ! J-tW� � � CDS.pmnu �[��� PK ! �kyw w /� SRV.pmnu �[��� PK ! �z��g g �� NS.pmnu �[��� PK ! Ǝ�;h h x� CAA.pmnu �[��� PK ! ��vA� � � A.pmnu �[��� PK ! �|� � � � CERT.pmnu �[��� PK ! ����7 7 � NSEC3PARAM.pmnu �[��� PK ! ?�[ & KEY.pmnu �[��� PK ! � �K1 K1 Q/ NSEC3.pmnu �[��� PK > > 2 �`
| ver. 1.1 | |
.
| PHP 8.4.18 | Ð“ÐµÐ½ÐµÑ€Ð°Ñ†Ð¸Ñ Ñтраницы: 0.03 |
proxy
|
phpinfo
|
ÐаÑтройка