1package Net::DNS::DomainName; 2 3use strict; 4use warnings; 5 6our $VERSION = (qw$Id: DomainName.pm 1813 2020-10-08 21:58:40Z willem $)[2]; 7 8 9=head1 NAME 10 11Net::DNS::DomainName - DNS name representation 12 13=head1 SYNOPSIS 14 15 use Net::DNS::DomainName; 16 17 $object = Net::DNS::DomainName->new('example.com'); 18 $name = $object->name; 19 $data = $object->encode; 20 21 ( $object, $next ) = Net::DNS::DomainName->decode( \$data, $offset ); 22 23=head1 DESCRIPTION 24 25The Net::DNS::DomainName module implements the concrete representation 26of DNS domain names used within DNS packets. 27 28Net::DNS::DomainName defines methods for encoding and decoding wire 29format octet strings. All other behaviour is inherited from 30Net::DNS::Domain. 31 32The Net::DNS::DomainName1035 and Net::DNS::DomainName2535 packages 33implement disjoint domain name subtypes which provide the name 34compression and canonicalisation specified by RFC1035 and RFC2535. 35These are necessary to meet the backward compatibility requirements 36introduced by RFC3597. 37 38=cut 39 40 41use base qw(Net::DNS::Domain); 42 43use integer; 44use Carp; 45 46 47=head1 METHODS 48 49=head2 new 50 51 $object = Net::DNS::DomainName->new('example.com'); 52 53Creates a domain name object which identifies the domain specified 54by the character string argument. 55 56 57=head2 canonical 58 59 $data = $object->canonical; 60 61Returns the canonical wire-format representation of the domain name 62as defined in RFC2535(8.1). 63 64=cut 65 66sub canonical { 67 my @label = shift->_wire; 68 for (@label) { 69 tr /\101-\132/\141-\172/; 70 } 71 return join '', map { pack 'C a*', length($_), $_ } @label, ''; 72} 73 74 75=head2 decode 76 77 $object = Net::DNS::DomainName->decode( \$buffer, $offset, $hash ); 78 79 ( $object, $next ) = Net::DNS::DomainName->decode( \$buffer, $offset, $hash ); 80 81Creates a domain name object which represents the DNS domain name 82identified by the wire-format data at the indicated offset within 83the data buffer. 84 85The argument list consists of a reference to a scalar containing the 86wire-format data and specified offset. The optional reference to a 87hash table provides improved efficiency of decoding compressed names 88by exploiting already cached compression pointers. 89 90The returned offset value indicates the start of the next item in the 91data buffer. 92 93=cut 94 95sub decode { 96 my $label = []; 97 my $self = bless {label => $label}, shift; 98 my $buffer = shift; # reference to data buffer 99 my $offset = shift || 0; # offset within buffer 100 my $cache = shift || {}; # hashed objectref by offset 101 102 my $buflen = length $$buffer; 103 my $index = $offset; 104 105 while ( $index < $buflen ) { 106 my $header = unpack( "\@$index C", $$buffer ) 107 || return wantarray ? ( $self, ++$index ) : $self; 108 109 if ( $header < 0x40 ) { # non-terminal label 110 push @$label, substr( $$buffer, ++$index, $header ); 111 $index += $header; 112 113 } elsif ( $header < 0xC0 ) { # deprecated extended label types 114 croak 'unimplemented label type'; 115 116 } else { # compression pointer 117 my $link = 0x3FFF & unpack( "\@$index n", $$buffer ); 118 croak 'corrupt compression pointer' unless $link < $offset; 119 120 # uncoverable condition false 121 $self->{origin} = $cache->{$link} ||= Net::DNS::DomainName->decode( $buffer, $link, $cache ); 122 return wantarray ? ( $self, $index + 2 ) : $self; 123 } 124 } 125 croak 'corrupt wire-format data'; 126} 127 128 129=head2 encode 130 131 $data = $object->encode; 132 133Returns the wire-format representation of the domain name suitable 134for inclusion in a DNS packet buffer. 135 136=cut 137 138sub encode { 139 return join '', map { pack 'C a*', length($_), $_ } shift->_wire, ''; 140} 141 142 143######################################## 144 145package Net::DNS::DomainName1035; ## no critic ProhibitMultiplePackages 146our @ISA = qw(Net::DNS::DomainName); 147 148=head1 Net::DNS::DomainName1035 149 150Net::DNS::DomainName1035 implements a subclass of domain name 151objects which are to be encoded using the compressed wire format 152defined in RFC1035. 153 154 use Net::DNS::DomainName; 155 156 $object = Net::DNS::DomainName1035->new('compressible.example.com'); 157 $data = $object->encode( $offset, $hash ); 158 159 ( $object, $next ) = Net::DNS::DomainName1035->decode( \$data, $offset ); 160 161Note that RFC3597 implies that the RR types defined in RFC1035 162section 3.3 are the only types eligible for compression. 163 164 165=head2 encode 166 167 $data = $object->encode( $offset, $hash ); 168 169Returns the wire-format representation of the domain name suitable 170for inclusion in a DNS packet buffer. 171 172The optional arguments are the offset within the packet data where 173the domain name is to be stored and a reference to a hash table used 174to index compressed names within the packet. 175 176If the hash reference is undefined, encode() returns the lowercase 177uncompressed canonical representation defined in RFC2535(8.1). 178 179=cut 180 181sub encode { 182 my $self = shift; 183 my $offset = shift || 0; # offset in data buffer 184 my $hash = shift || return $self->canonical; # hashed offset by name 185 186 my @labels = $self->_wire; 187 my $data = ''; 188 while (@labels) { 189 my $name = join( '.', @labels ); 190 191 return $data . pack( 'n', 0xC000 | $hash->{$name} ) if defined $hash->{$name}; 192 193 my $label = shift @labels; 194 my $length = length $label; 195 $data .= pack( 'C a*', $length, $label ); 196 197 next unless $offset < 0x4000; 198 $hash->{$name} = $offset; 199 $offset += 1 + $length; 200 } 201 return $data .= pack 'x'; 202} 203 204 205######################################## 206 207package Net::DNS::DomainName2535; ## no critic ProhibitMultiplePackages 208our @ISA = qw(Net::DNS::DomainName); 209 210=head1 Net::DNS::DomainName2535 211 212Net::DNS::DomainName2535 implements a subclass of domain name 213objects which are to be encoded using uncompressed wire format. 214 215Note that RFC3597, and latterly RFC4034, specifies that the lower 216case canonical encoding defined in RFC2535 is to be used for RR 217types defined prior to RFC3597. 218 219 use Net::DNS::DomainName; 220 221 $object = Net::DNS::DomainName2535->new('incompressible.example.com'); 222 $data = $object->encode( $offset, $hash ); 223 224 ( $object, $next ) = Net::DNS::DomainName2535->decode( \$data, $offset ); 225 226 227=head2 encode 228 229 $data = $object->encode( $offset, $hash ); 230 231Returns the uncompressed wire-format representation of the domain 232name suitable for inclusion in a DNS packet buffer. 233 234If the hash reference is undefined, encode() returns the lowercase 235canonical form defined in RFC2535(8.1). 236 237=cut 238 239sub encode { 240 my ( $self, $offset, $hash ) = @_; 241 return $self->canonical unless defined $hash; 242 return join '', map { pack 'C a*', length($_), $_ } $self->_wire, ''; 243} 244 2451; 246__END__ 247 248 249######################################## 250 251=head1 COPYRIGHT 252 253Copyright (c)2009-2011 Dick Franks. 254 255All rights reserved. 256 257 258=head1 LICENSE 259 260Permission to use, copy, modify, and distribute this software and its 261documentation for any purpose and without fee is hereby granted, provided 262that the above copyright notice appear in all copies and that both that 263copyright notice and this permission notice appear in supporting 264documentation, and that the name of the author not be used in advertising 265or publicity pertaining to distribution of the software without specific 266prior written permission. 267 268THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 269IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 270FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 271THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 272LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 273FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 274DEALINGS IN THE SOFTWARE. 275 276 277=head1 SEE ALSO 278 279L<perl>, L<Net::DNS>, L<Net::DNS::Domain>, RFC1035, RFC2535, 280RFC3597, RFC4034 281 282=cut 283 284