← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:19 2017

Filename/usr/local/lib/perl5/site_perl/Net/DNS/Header.pm
StatementsExecuted 29532 statements in 141ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
39362253.5ms53.5msNet::DNS::Header::::idNet::DNS::Header::id
19681145.4ms45.4msNet::DNS::Header::::_dnsflagNet::DNS::Header::_dnsflag
19681125.6ms71.0msNet::DNS::Header::::rdNet::DNS::Header::rd
11144µs64µsNet::DNS::Header::::BEGIN@28Net::DNS::Header::BEGIN@28
11132µs69µsNet::DNS::Header::::BEGIN@29Net::DNS::Header::BEGIN@29
11129µs34µsNet::DNS::Header::::BEGIN@30Net::DNS::Header::BEGIN@30
11124µs764µsNet::DNS::Header::::BEGIN@33Net::DNS::Header::BEGIN@33
11122µs244µsNet::DNS::Header::::BEGIN@31Net::DNS::Header::BEGIN@31
0000s0sNet::DNS::Header::::_ednsflagNet::DNS::Header::_ednsflag
0000s0sNet::DNS::Header::::aaNet::DNS::Header::aa
0000s0sNet::DNS::Header::::adNet::DNS::Header::ad
0000s0sNet::DNS::Header::::adcountNet::DNS::Header::adcount
0000s0sNet::DNS::Header::::ancountNet::DNS::Header::ancount
0000s0sNet::DNS::Header::::arcountNet::DNS::Header::arcount
0000s0sNet::DNS::Header::::cdNet::DNS::Header::cd
0000s0sNet::DNS::Header::::doNet::DNS::Header::do
0000s0sNet::DNS::Header::::ednsNet::DNS::Header::edns
0000s0sNet::DNS::Header::::nscountNet::DNS::Header::nscount
0000s0sNet::DNS::Header::::opcodeNet::DNS::Header::opcode
0000s0sNet::DNS::Header::::prcountNet::DNS::Header::prcount
0000s0sNet::DNS::Header::::printNet::DNS::Header::print
0000s0sNet::DNS::Header::::qdcountNet::DNS::Header::qdcount
0000s0sNet::DNS::Header::::qrNet::DNS::Header::qr
0000s0sNet::DNS::Header::::raNet::DNS::Header::ra
0000s0sNet::DNS::Header::::rcodeNet::DNS::Header::rcode
0000s0sNet::DNS::Header::::sizeNet::DNS::Header::size
0000s0sNet::DNS::Header::::stringNet::DNS::Header::string
0000s0sNet::DNS::Header::::tcNet::DNS::Header::tc
0000s0sNet::DNS::Header::::upcountNet::DNS::Header::upcount
0000s0sNet::DNS::Header::::zNet::DNS::Header::z
0000s0sNet::DNS::Header::::zocountNet::DNS::Header::zocount
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::Header;
2
3#
4# $Id: Header.pm 1527 2017-01-18 21:42:48Z willem $
5#
612µsour $VERSION = (qw$LastChangedRevision: 1527 $)[1];
7
8
9=head1 NAME
10
11Net::DNS::Header - DNS packet header
12
13=head1 SYNOPSIS
14
15 use Net::DNS;
16
17 $packet = new Net::DNS::Packet;
18 $header = $packet->header;
19
20
21=head1 DESCRIPTION
22
23C<Net::DNS::Header> represents the header portion of a DNS packet.
24
25=cut
26
27
28274µs285µs
# spent 64µs (44+20) within Net::DNS::Header::BEGIN@28 which was called: # once (44µs+20µs) by Net::DNS::Packet::BEGIN@36 at line 28
use strict;
# spent 64µs making 1 call to Net::DNS::Header::BEGIN@28 # spent 20µs making 1 call to strict::import
29256µs2106µs
# spent 69µs (32+37) within Net::DNS::Header::BEGIN@29 which was called: # once (32µs+37µs) by Net::DNS::Packet::BEGIN@36 at line 29
use warnings;
# spent 69µs making 1 call to Net::DNS::Header::BEGIN@29 # spent 37µs making 1 call to warnings::import
30268µs239µs
# spent 34µs (29+5) within Net::DNS::Header::BEGIN@30 which was called: # once (29µs+5µs) by Net::DNS::Packet::BEGIN@36 at line 30
use integer;
# spent 34µs making 1 call to Net::DNS::Header::BEGIN@30 # spent 5µs making 1 call to integer::import
31257µs2466µs
# spent 244µs (22+222) within Net::DNS::Header::BEGIN@31 which was called: # once (22µs+222µs) by Net::DNS::Packet::BEGIN@36 at line 31
use Carp;
# spent 244µs making 1 call to Net::DNS::Header::BEGIN@31 # spent 222µs making 1 call to Exporter::import
32
3322.69ms21.50ms
# spent 764µs (24+740) within Net::DNS::Header::BEGIN@33 which was called: # once (24µs+740µs) by Net::DNS::Packet::BEGIN@36 at line 33
use Net::DNS::Parameters;
# spent 764µs making 1 call to Net::DNS::Header::BEGIN@33 # spent 740µs making 1 call to Exporter::import
34
35
36=head1 METHODS
37
38
39=head2 $packet->header
40
41 $packet = new Net::DNS::Packet;
42 $header = $packet->header;
43
44Net::DNS::Header objects emanate from the Net::DNS::Packet header()
45method, and contain an opaque reference to the parent Packet object.
46
47Header objects may be assigned to suitably scoped lexical variables.
48They should never be stored in global variables or persistent data
49structures.
50
51
52=head2 string
53
54 print $packet->header->string;
55
56Returns a string representation of the packet header.
57
58=cut
59
60sub string {
61 my $self = shift;
62
63 my $id = $self->id;
64 my $qr = $self->qr;
65 my $opcode = $self->opcode;
66 my $rcode = $self->rcode;
67 my $qd = $self->qdcount;
68 my $an = $self->ancount;
69 my $ns = $self->nscount;
70 my $ar = $self->arcount;
71
72 my $opt = $$self->edns;
73 my $edns = $opt->_specified ? $opt->string : '';
74
75 return <<END . $edns if $opcode eq 'UPDATE';
76;; id = $id
77;; qr = $qr opcode = $opcode rcode = $rcode
78;; zocount = $qd prcount = $an upcount = $ns adcount = $ar
79END
80
81 my $aa = $self->aa;
82 my $tc = $self->tc;
83 my $rd = $self->rd;
84 my $ra = $self->ra;
85 my $zz = $self->z;
86 my $ad = $self->ad;
87 my $cd = $self->cd;
88 my $do = $self->do;
89
90 return <<END . $edns;
91;; id = $id
92;; qr = $qr aa = $aa tc = $tc rd = $rd opcode = $opcode
93;; ra = $ra z = $zz ad = $ad cd = $cd rcode = $rcode
94;; qdcount = $qd ancount = $an nscount = $ns arcount = $ar
95;; do = $do
96END
97}
98
99
100=head2 print
101
102 $packet->header->print;
103
104Prints the string representation of the packet header.
105
106=cut
107
108sub print { print &string; }
109
110
111=head2 id
112
113 print "query id = ", $packet->header->id, "\n";
114 $packet->header->id(1234);
115
116Gets or sets the query identification number.
117
118A random value is assigned if the argument value is undefined.
119
120=cut
121
122
# spent 53.5ms within Net::DNS::Header::id which was called 3936 times, avg 14µs/call: # 1968 times (30.9ms+0s) by Net::DNS::Packet::encode at line 200 of Net/DNS/Packet.pm, avg 16µs/call # 1968 times (22.6ms+0s) by Mail::SpamAssassin::DnsResolver::_packet_id at line 623 of Mail/SpamAssassin/DnsResolver.pm, avg 11µs/call
sub id {
12339369.84ms my $self = shift;
12439367.54ms $$self->{id} = shift if scalar @_;
125393622.6ms return $$self->{id} if defined $$self->{id};
126196823.8ms $$self->{id} = int rand(0xffff);
127}
128
129
130=head2 opcode
131
132 print "query opcode = ", $packet->header->opcode, "\n";
133 $packet->header->opcode("UPDATE");
134
135Gets or sets the query opcode (the purpose of the query).
136
137=cut
138
139sub opcode {
140 my $self = shift;
141 for ( $$self->{status} ) {
142 return opcodebyval( ( $_ >> 11 ) & 0x0f ) unless scalar @_;
143 my $opcode = opcodebyname(shift);
144 $_ = ( $_ & 0x87ff ) | ( $opcode << 11 );
145 return $opcode;
146 }
147}
148
149
150=head2 rcode
151
152 print "query response code = ", $packet->header->rcode, "\n";
153 $packet->header->rcode("SERVFAIL");
154
155Gets or sets the query response code (the status of the query).
156
157=cut
158
159sub rcode {
160 my $self = shift;
161 for ( $$self->{status} ) {
162 my $arg = shift;
163 my $opt = $$self->edns;
164 unless ( defined $arg ) {
165 my $rcode = $opt->rcode;
166 return rcodebyval( $_ & 0x0f ) unless $opt->_specified;
167 $rcode = ( $rcode & 0xff0 ) | ( $_ & 0x00f );
168 $opt->rcode($rcode); # write back full 12-bit rcode
169 return $rcode == 16 ? 'BADVERS' : rcodebyval($rcode);
170 }
171 my $rcode = rcodebyname($arg);
172 $opt->rcode($rcode); # full 12-bit rcode
173 $_ &= 0xfff0; # low 4-bit rcode
174 $_ |= ( $rcode & 0x000f );
175 return $rcode;
176 }
177}
178
179
180=head2 qr
181
182 print "query response flag = ", $packet->header->qr, "\n";
183 $packet->header->qr(0);
184
185Gets or sets the query response flag.
186
187=cut
188
189sub qr {
190 shift->_dnsflag( 0x8000, @_ );
191}
192
193
194=head2 aa
195
196 print "answer is ", $packet->header->aa ? "" : "non-", "authoritative\n";
197 $packet->header->aa(0);
198
199Gets or sets the authoritative answer flag.
200
201=cut
202
203sub aa {
204 shift->_dnsflag( 0x0400, @_ );
205}
206
207
208=head2 tc
209
210 print "packet is ", $packet->header->tc ? "" : "not ", "truncated\n";
211 $packet->header->tc(0);
212
213Gets or sets the truncated packet flag.
214
215=cut
216
217sub tc {
218 shift->_dnsflag( 0x0200, @_ );
219}
220
221
222=head2 rd
223
224 print "recursion was ", $packet->header->rd ? "" : "not ", "desired\n";
225 $packet->header->rd(0);
226
227Gets or sets the recursion desired flag.
228
229=cut
230
231
# spent 71.0ms (25.6+45.4) within Net::DNS::Header::rd which was called 1968 times, avg 36µs/call: # 1968 times (25.6ms+45.4ms) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 596 of Mail/SpamAssassin/DnsResolver.pm, avg 36µs/call
sub rd {
232196823.6ms196845.4ms shift->_dnsflag( 0x0100, @_ );
# spent 45.4ms making 1968 calls to Net::DNS::Header::_dnsflag, avg 23µs/call
233}
234
235
236=head2 ra
237
238 print "recursion is ", $packet->header->ra ? "" : "not ", "available\n";
239 $packet->header->ra(0);
240
241Gets or sets the recursion available flag.
242
243=cut
244
245sub ra {
246 shift->_dnsflag( 0x0080, @_ );
247}
248
249
250=head2 z
251
252Unassigned bit, should always be zero.
253
254=cut
255
256sub z {
257 shift->_dnsflag( 0x0040, @_ );
258}
259
260
261=head2 ad
262
263 print "The result has ", $packet->header->ad ? "" : "not", "been verified\n";
264
265Relevant in DNSSEC context.
266
267(The AD bit is only set on answers where signatures have been
268cryptographically verified or the server is authoritative for the data
269and is allowed to set the bit by policy.)
270
271=cut
272
273sub ad {
274 shift->_dnsflag( 0x0020, @_ );
275}
276
277
278=head2 cd
279
280 print "checking was ", $packet->header->cd ? "not" : "", "desired\n";
281 $packet->header->cd(0);
282
283Gets or sets the checking disabled flag.
284
285=cut
286
287sub cd {
288 shift->_dnsflag( 0x0010, @_ );
289}
290
291
292=head2 qdcount, zocount
293
294 print "# of question records: ", $packet->header->qdcount, "\n";
295
296Returns the number of records in the question section of the packet.
297In dynamic update packets, this field is known as C<zocount> and refers
298to the number of RRs in the zone section.
299
300=cut
301
302our $warned;
303
304sub qdcount {
305 my $self = shift;
306 return $$self->{count}[0] || scalar @{$$self->{question}} unless scalar @_;
307 carp 'header->qdcount attribute is read-only' unless $warned++;
308}
309
310
311=head2 ancount, prcount
312
313 print "# of answer records: ", $packet->header->ancount, "\n";
314
315Returns the number of records in the answer section of the packet
316which may, in the case of corrupt packets, differ from the actual
317number of records.
318In dynamic update packets, this field is known as C<prcount> and refers
319to the number of RRs in the prerequisite section.
320
321=cut
322
323sub ancount {
324 my $self = shift;
325 return $$self->{count}[1] || scalar @{$$self->{answer}} unless scalar @_;
326 carp 'header->ancount attribute is read-only' unless $warned++;
327}
328
329
330=head2 nscount, upcount
331
332 print "# of authority records: ", $packet->header->nscount, "\n";
333
334Returns the number of records in the authority section of the packet
335which may, in the case of corrupt packets, differ from the actual
336number of records.
337In dynamic update packets, this field is known as C<upcount> and refers
338to the number of RRs in the update section.
339
340=cut
341
342sub nscount {
343 my $self = shift;
344 return $$self->{count}[2] || scalar @{$$self->{authority}} unless scalar @_;
345 carp 'header->nscount attribute is read-only' unless $warned++;
346}
347
348
349=head2 arcount, adcount
350
351 print "# of additional records: ", $packet->header->arcount, "\n";
352
353Returns the number of records in the additional section of the packet
354which may, in the case of corrupt packets, differ from the actual
355number of records.
356In dynamic update packets, this field is known as C<adcount>.
357
358=cut
359
360sub arcount {
361 my $self = shift;
362 return $$self->{count}[3] || scalar @{$$self->{additional}} unless scalar @_;
363 carp 'header->arcount attribute is read-only' unless $warned++;
364}
365
366sub zocount { &qdcount; }
367sub prcount { &ancount; }
368sub upcount { &nscount; }
369sub adcount { &arcount; }
370
371
372=head1 EDNS Protocol Extensions
373
374
375=head2 do
376
377 print "DNSSEC_OK flag was ", $packet->header->do ? "not" : "", "set\n";
378 $packet->header->do(1);
379
380Gets or sets the EDNS DNSSEC OK flag.
381
382=cut
383
384sub do {
385 shift->_ednsflag( 0x8000, @_ );
386}
387
388
389=head2 Extended rcode
390
391EDNS extended rcodes are handled transparently by $packet->header->rcode().
392
393
394=head2 UDP packet size
395
396 $udp_max = $packet->header->size;
397 $udp_max = $packet->edns->size;
398
399EDNS offers a mechanism to advertise the maximum UDP packet size
400which can be assembled by the local network stack.
401
402UDP size advertisement can be viewed as either a header extension or
403an EDNS feature. Endless debate is avoided by supporting both views.
404
405=cut
406
407sub size {
408 my $self = shift;
409 return $$self->edns->size(@_);
410}
411
412
413=head2 edns
414
415 $header = $packet->header;
416 $version = $header->edns->version;
417 @options = $header->edns->options;
418 $option = $header->edns->option(n);
419 $udp_max = $packet->edns->size;
420
421Auxiliary function which provides access to the EDNS protocol
422extension OPT RR.
423
424=cut
425
426sub edns {
427 my $self = shift;
428 return $$self->edns;
429}
430
431
432########################################
433
434
# spent 45.4ms within Net::DNS::Header::_dnsflag which was called 1968 times, avg 23µs/call: # 1968 times (45.4ms+0s) by Net::DNS::Header::rd at line 232, avg 23µs/call
sub _dnsflag {
43519683.72ms my $self = shift;
43619683.67ms my $flag = shift;
43719689.87ms for ( $$self->{status} ) {
43819684.48ms my $set = $_ | $flag;
43919684.09ms my $not = $set - $flag;
44019684.47ms $_ = (shift) ? $set : $not if scalar @_;
441196820.7ms return ( $_ & $flag ) ? 1 : 0;
442 }
443}
444
445
446sub _ednsflag {
447 my $self = shift;
448 my $flag = shift;
449 my $edns = $$self->edns->flags || 0;
450 return $flag & $edns ? 1 : 0 unless scalar @_;
451 my $set = $flag | $edns;
452 my $not = $set - $flag;
453 my $new = (shift) ? $set : $not;
454 $$self->edns->flags($new) unless $new == $edns;
455 return ( $new & $flag ) ? 1 : 0;
456}
457
458
459116µs1;
460__END__
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.