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