← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:13 2021

Filename/usr/local/lib/perl5/site_perl/Net/DNS/DomainName.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sNet::DNS::DomainName1035::::encodeNet::DNS::DomainName1035::encode
0000s0sNet::DNS::DomainName2535::::encodeNet::DNS::DomainName2535::encode
0000s0sNet::DNS::DomainName::::BEGIN@3 Net::DNS::DomainName::BEGIN@3
0000s0sNet::DNS::DomainName::::BEGIN@4 Net::DNS::DomainName::BEGIN@4
0000s0sNet::DNS::DomainName::::BEGIN@41 Net::DNS::DomainName::BEGIN@41
0000s0sNet::DNS::DomainName::::BEGIN@43 Net::DNS::DomainName::BEGIN@43
0000s0sNet::DNS::DomainName::::BEGIN@44 Net::DNS::DomainName::BEGIN@44
0000s0sNet::DNS::DomainName::::canonical Net::DNS::DomainName::canonical
0000s0sNet::DNS::DomainName::::decode Net::DNS::DomainName::decode
0000s0sNet::DNS::DomainName::::encode Net::DNS::DomainName::encode
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
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__