← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:02 2017

Filename/usr/local/lib/perl5/site_perl/Net/DNS/DomainName.pm
StatementsExecuted 89594 statements in 554ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
196811450ms521msNet::DNS::DomainName1035::::encodeNet::DNS::DomainName1035::encode
30062258.3ms58.3msNet::DNS::DomainName::::_wire Net::DNS::DomainName::_wire
83481125.8ms25.8msNet::DNS::DomainName1035::::CORE:packNet::DNS::DomainName1035::CORE:pack (opcode)
11147µs58µsNet::DNS::DomainName::::BEGIN@41 Net::DNS::DomainName::BEGIN@41
11138µs292µsNet::DNS::DomainName1035::::BEGIN@158Net::DNS::DomainName1035::BEGIN@158
11128µs60µsNet::DNS::DomainName::::BEGIN@42 Net::DNS::DomainName::BEGIN@42
11124µs270µsNet::DNS::DomainName::::BEGIN@43 Net::DNS::DomainName::BEGIN@43
11123µs280µsNet::DNS::DomainName2535::::BEGIN@220Net::DNS::DomainName2535::BEGIN@220
11121µs29µsNet::DNS::DomainName::::BEGIN@45 Net::DNS::DomainName::BEGIN@45
11120µs221µsNet::DNS::DomainName::::BEGIN@46 Net::DNS::DomainName::BEGIN@46
0000s0sNet::DNS::DomainName2535::::encodeNet::DNS::DomainName2535::encode
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
3#
4# $Id: DomainName.pm 1558 2017-04-03 11:38:22Z willem $
5#
612µsour $VERSION = (qw$LastChangedRevision: 1558 $)[1];
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 = new Net::DNS::DomainName('example.com');
18 $name = $object->name;
19 $data = $object->encode;
20
21 ( $object, $next ) = decode Net::DNS::DomainName( \$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 as defined in RFC1035. All other behaviour,
30including the new() constructor, is inherited from Net::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
41285µs269µs
# spent 58µs (47+11) within Net::DNS::DomainName::BEGIN@41 which was called: # once (47µs+11µs) by Net::DNS::RR::BEGIN@43 at line 41
use strict;
# spent 58µs making 1 call to Net::DNS::DomainName::BEGIN@41 # spent 11µs making 1 call to strict::import
42276µs292µs
# spent 60µs (28+32) within Net::DNS::DomainName::BEGIN@42 which was called: # once (28µs+32µs) by Net::DNS::RR::BEGIN@43 at line 42
use warnings;
# spent 60µs making 1 call to Net::DNS::DomainName::BEGIN@42 # spent 32µs making 1 call to warnings::import
43278µs2270µs
# spent 270µs (24+246) within Net::DNS::DomainName::BEGIN@43 which was called: # once (24µs+246µs) by Net::DNS::RR::BEGIN@43 at line 43
use base qw(Net::DNS::Domain);
# spent 270µs making 1 call to Net::DNS::DomainName::BEGIN@43 # spent 246µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 246µs
44
45256µs236µs
# spent 29µs (21+7) within Net::DNS::DomainName::BEGIN@45 which was called: # once (21µs+7µs) by Net::DNS::RR::BEGIN@43 at line 45
use integer;
# spent 29µs making 1 call to Net::DNS::DomainName::BEGIN@45 # spent 7µs making 1 call to integer::import
462828µs2421µs
# spent 221µs (20+201) within Net::DNS::DomainName::BEGIN@46 which was called: # once (20µs+201µs) by Net::DNS::RR::BEGIN@43 at line 46
use Carp;
# spent 221µs making 1 call to Net::DNS::DomainName::BEGIN@46 # spent 201µs making 1 call to Exporter::import
47
48
49=head1 METHODS
50
51=head2 new
52
53 $object = new Net::DNS::DomainName('example.com');
54
55Creates a domain name object which identifies the domain specified
56by the character string argument.
57
58
59=head2 canonical
60
61 $data = $object->canonical;
62
63Returns the canonical wire-format representation of the domain name
64as defined in RFC2535(8.1).
65
66=cut
67
68sub canonical {
69 join '', map( { tr /\101-\132/\141-\172/;
70 pack 'C a*', length($_), $_;
71 } shift->_wire ),
7214µs pack 'x';
# spent 4µs making 1 call to main::CORE:pack
73}
74
75
76=head2 decode
77
78 $object = decode Net::DNS::DomainName( \$buffer, $offset, $hash );
79
80 ( $object, $next ) = decode Net::DNS::DomainName( \$buffer, $offset, $hash );
81
82Creates a domain name object which represents the DNS domain name
83identified by the wire-format data at the indicated offset within
84the data buffer.
85
86The argument list consists of a reference to a scalar containing the
87wire-format data and specified offset. The optional reference to a
88hash table provides improved efficiency of decoding compressed names
89by exploiting already cached compression pointers.
90
91The returned offset value indicates the start of the next item in the
92data buffer.
93
94=cut
95
96sub decode {
97 my $label = [];
98 my $self = bless {label => $label}, shift;
99 my $buffer = shift; # reference to data buffer
100 my $offset = shift || 0; # offset within buffer
101 my $cache = shift || {}; # hashed objectref by offset
102
103 my $buflen = length $$buffer;
104 my $index = $offset;
105
106 while ( $index < $buflen ) {
107 my $header = unpack( "\@$index C", $$buffer )
108 || return wantarray ? ( $self, ++$index ) : $self;
109
110 if ( $header < 0x40 ) { # non-terminal label
111 push @$label, substr( $$buffer, ++$index, $header );
112 $index += $header;
113
114 } elsif ( $header < 0xC0 ) { # deprecated extended label types
115 croak 'unimplemented label type';
116
117 } else { # compression pointer
118 my $link = 0x3FFF & unpack( "\@$index n", $$buffer );
119 croak 'corrupt compression pointer' unless $link < $offset;
120
121 # uncoverable condition false
122 $self->{origin} = $cache->{$link} ||= decode Net::DNS::DomainName( $buffer, $link, $cache );
123 return wantarray ? ( $self, $index + 2 ) : $self;
124 }
125 }
126 croak 'corrupt wire-format data';
127}
128
129
130=head2 encode
131
132 $data = $object->encode;
133
134Returns the wire-format representation of the domain name suitable
135for inclusion in a DNS packet buffer.
136
137=cut
138
139sub encode {
140 join '', map pack( 'C a*', length($_), $_ ), shift->_wire, '';
141}
142
143
144########################################
145
146
# spent 58.3ms within Net::DNS::DomainName::_wire which was called 3006 times, avg 19µs/call: # 1968 times (45.0ms+0s) by Net::DNS::DomainName1035::encode at line 198, avg 23µs/call # 1038 times (13.3ms+0s) by Net::DNS::Domain::name at line 167 of Net/DNS/Domain.pm, avg 13µs/call
sub _wire { ## Generate list of wire-format labels
14730065.27ms my $self = shift;
148
149300611.6ms my $label = $self->{label};
150300645.1ms my $origin = $self->{origin} || return (@$label);
151 return ( @$label, $origin->_wire );
152}
153
154
155########################################
156
157package Net::DNS::DomainName1035;
1582415µs2292µs
# spent 292µs (38+255) within Net::DNS::DomainName1035::BEGIN@158 which was called: # once (38µs+255µs) by Net::DNS::RR::BEGIN@43 at line 158
use base qw(Net::DNS::DomainName);
# spent 292µs making 1 call to Net::DNS::DomainName1035::BEGIN@158 # spent 255µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 255µs
159
160=head1 Net::DNS::DomainName1035
161
162Net::DNS::DomainName1035 implements a subclass of domain name
163objects which are to be encoded using the compressed wire format
164defined in RFC1035.
165
166 use Net::DNS::DomainName;
167
168 $object = new Net::DNS::DomainName1035('compressible.example.com');
169 $data = $object->encode( $offset, $hash );
170
171 ( $object, $next ) = decode Net::DNS::DomainName1035( \$data, $offset );
172
173Note that RFC3597 implies that the RR types defined in RFC1035
174section 3.3 are the only types eligible for compression.
175
176
177=head2 encode
178
179 $data = $object->encode( $offset, $hash );
180
181Returns the wire-format representation of the domain name suitable
182for inclusion in a DNS packet buffer.
183
184The optional arguments are the offset within the packet data where
185the domain name is to be stored and a reference to a hash table used
186to index compressed names within the packet.
187
188If the hash reference is undefined, encode() returns the lowercase
189uncompressed canonical representation defined in RFC2535(8.1).
190
191=cut
192
193
# spent 521ms (450+70.8) within Net::DNS::DomainName1035::encode which was called 1968 times, avg 265µs/call: # 1968 times (450ms+70.8ms) by Net::DNS::Question::encode at line 139 of Net/DNS/Question.pm, avg 265µs/call
sub encode {
19419683.49ms my $self = shift;
19519684.37ms my $offset = shift || 0; # offset in data buffer
19619684.21ms my $hash = shift || return $self->canonical; # hashed offset by name
197
198196836.0ms196845.0ms my @labels = $self->_wire;
# spent 45.0ms making 1968 calls to Net::DNS::DomainName::_wire, avg 23µs/call
19919684.03ms my $data = '';
20019687.26ms while (@labels) {
201834832.1ms my $name = join( '.', @labels );
202
203834816.6ms return $data . pack( 'n', 0xC000 | $hash->{$name} ) if defined $hash->{$name};
204
205834823.3ms my $label = shift @labels;
206834820.6ms my $length = length $label;
2078348172ms834825.8ms $data .= pack( 'C a*', $length, $label );
# spent 25.8ms making 8348 calls to Net::DNS::DomainName1035::CORE:pack, avg 3µs/call
208
209834814.8ms next unless $offset < 0x4000;
210834871.0ms $hash->{$name} = $offset;
211834847.9ms $offset += 1 + $length;
212 }
213196831.9ms13µs $data .= pack 'x';
# spent 3µs making 1 call to main::CORE:pack
214}
215
216
217########################################
218
219package Net::DNS::DomainName2535;
2202209µs2280µs
# spent 280µs (23+257) within Net::DNS::DomainName2535::BEGIN@220 which was called: # once (23µs+257µs) by Net::DNS::RR::BEGIN@43 at line 220
use base qw(Net::DNS::DomainName);
# spent 280µs making 1 call to Net::DNS::DomainName2535::BEGIN@220 # spent 257µs making 1 call to base::import, recursion: max depth 2, sum of overlapping time 257µs
221
222=head1 Net::DNS::DomainName2535
223
224Net::DNS::DomainName2535 implements a subclass of domain name
225objects which are to be encoded using uncompressed wire format.
226
227Note that RFC3597, and latterly RFC4034, specifies that the lower
228case canonical encoding defined in RFC2535 is to be used for RR
229types defined prior to RFC3597.
230
231 use Net::DNS::DomainName;
232
233 $object = new Net::DNS::DomainName2535('incompressible.example.com');
234 $data = $object->encode( $offset, $hash );
235
236 ( $object, $next ) = decode Net::DNS::DomainName2535( \$data, $offset );
237
238
239=head2 encode
240
241 $data = $object->encode( $offset, $hash );
242
243Returns the uncompressed wire-format representation of the domain
244name suitable for inclusion in a DNS packet buffer.
245
246If the hash reference is undefined, encode() returns the lowercase
247canonical form defined in RFC2535(8.1).
248
249=cut
250
251sub encode {
252 return shift->canonical unless defined $_[2];
253 join '', map pack( 'C a*', length($_), $_ ), shift->_wire, '';
254}
255
256115µs1;
257__END__
 
# spent 25.8ms within Net::DNS::DomainName1035::CORE:pack which was called 8348 times, avg 3µs/call: # 8348 times (25.8ms+0s) by Net::DNS::DomainName1035::encode at line 207, avg 3µs/call
sub Net::DNS::DomainName1035::CORE:pack; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.