Filename | /usr/local/lib/perl5/site_perl/Net/DNS/Header.pm |
Statements | Executed 29532 statements in 187ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1968 | 1 | 1 | 53.5ms | 98.9ms | rd | Net::DNS::Header::
3936 | 2 | 2 | 52.1ms | 52.1ms | id | Net::DNS::Header::
1968 | 1 | 1 | 45.4ms | 45.4ms | _dnsflag | Net::DNS::Header::
1 | 1 | 1 | 51µs | 59µs | BEGIN@28 | Net::DNS::Header::
1 | 1 | 1 | 27µs | 32µs | BEGIN@30 | Net::DNS::Header::
1 | 1 | 1 | 27µs | 63µs | BEGIN@29 | Net::DNS::Header::
1 | 1 | 1 | 23µs | 756µs | BEGIN@33 | Net::DNS::Header::
1 | 1 | 1 | 18µs | 222µs | BEGIN@31 | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | _ednsflag | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | aa | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | ad | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | adcount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | ancount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | arcount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | cd | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | do | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | edns | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | nscount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | opcode | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | prcount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | |
0 | 0 | 0 | 0s | 0s | qdcount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | qr | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | ra | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | rcode | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | size | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | string | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | tc | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | upcount | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | z | Net::DNS::Header::
0 | 0 | 0 | 0s | 0s | zocount | Net::DNS::Header::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Net::DNS::Header; | ||||
2 | |||||
3 | # | ||||
4 | # $Id: Header.pm 1527 2017-01-18 21:42:48Z willem $ | ||||
5 | # | ||||
6 | 1 | 2µs | our $VERSION = (qw$LastChangedRevision: 1527 $)[1]; | ||
7 | |||||
8 | |||||
9 | =head1 NAME | ||||
10 | |||||
11 | Net::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 | |||||
23 | C<Net::DNS::Header> represents the header portion of a DNS packet. | ||||
24 | |||||
25 | =cut | ||||
26 | |||||
27 | |||||
28 | 2 | 68µs | 2 | 66µs | # spent 59µs (51+8) within Net::DNS::Header::BEGIN@28 which was called:
# once (51µs+8µs) by Net::DNS::Packet::BEGIN@36 at line 28 # spent 59µs making 1 call to Net::DNS::Header::BEGIN@28
# spent 8µs making 1 call to strict::import |
29 | 2 | 71µs | 2 | 100µs | # spent 63µs (27+36) within Net::DNS::Header::BEGIN@29 which was called:
# once (27µs+36µs) by Net::DNS::Packet::BEGIN@36 at line 29 # spent 63µs making 1 call to Net::DNS::Header::BEGIN@29
# spent 36µs making 1 call to warnings::import |
30 | 2 | 65µs | 2 | 37µs | # spent 32µs (27+5) within Net::DNS::Header::BEGIN@30 which was called:
# once (27µs+5µs) by Net::DNS::Packet::BEGIN@36 at line 30 # spent 32µs making 1 call to Net::DNS::Header::BEGIN@30
# spent 5µs making 1 call to integer::import |
31 | 2 | 58µs | 2 | 425µs | # spent 222µs (18+204) within Net::DNS::Header::BEGIN@31 which was called:
# once (18µs+204µs) by Net::DNS::Packet::BEGIN@36 at line 31 # spent 222µs making 1 call to Net::DNS::Header::BEGIN@31
# spent 204µs making 1 call to Exporter::import |
32 | |||||
33 | 2 | 2.65ms | 2 | 1.49ms | # spent 756µs (23+733) within Net::DNS::Header::BEGIN@33 which was called:
# once (23µs+733µs) by Net::DNS::Packet::BEGIN@36 at line 33 # spent 756µs making 1 call to Net::DNS::Header::BEGIN@33
# spent 733µ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 | |||||
44 | Net::DNS::Header objects emanate from the Net::DNS::Packet header() | ||||
45 | method, and contain an opaque reference to the parent Packet object. | ||||
46 | |||||
47 | Header objects may be assigned to suitably scoped lexical variables. | ||||
48 | They should never be stored in global variables or persistent data | ||||
49 | structures. | ||||
50 | |||||
51 | |||||
52 | =head2 string | ||||
53 | |||||
54 | print $packet->header->string; | ||||
55 | |||||
56 | Returns a string representation of the packet header. | ||||
57 | |||||
58 | =cut | ||||
59 | |||||
60 | sub 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 | ||||
79 | END | ||||
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 | ||||
96 | END | ||||
97 | } | ||||
98 | |||||
99 | |||||
100 | =head2 print | ||||
101 | |||||
102 | $packet->header->print; | ||||
103 | |||||
104 | Prints the string representation of the packet header. | ||||
105 | |||||
106 | =cut | ||||
107 | |||||
108 | sub print { print &string; } | ||||
109 | |||||
110 | |||||
111 | =head2 id | ||||
112 | |||||
113 | print "query id = ", $packet->header->id, "\n"; | ||||
114 | $packet->header->id(1234); | ||||
115 | |||||
116 | Gets or sets the query identification number. | ||||
117 | |||||
118 | A random value is assigned if the argument value is undefined. | ||||
119 | |||||
120 | =cut | ||||
121 | |||||
122 | # spent 52.1ms within Net::DNS::Header::id which was called 3936 times, avg 13µs/call:
# 1968 times (30.7ms+0s) by Net::DNS::Packet::encode at line 200 of Net/DNS/Packet.pm, avg 16µs/call
# 1968 times (21.4ms+0s) by Mail::SpamAssassin::DnsResolver::_packet_id at line 623 of Mail/SpamAssassin/DnsResolver.pm, avg 11µs/call | ||||
123 | 3936 | 8.27ms | my $self = shift; | ||
124 | 3936 | 7.32ms | $$self->{id} = shift if scalar @_; | ||
125 | 3936 | 33.2ms | return $$self->{id} if defined $$self->{id}; | ||
126 | 1968 | 31.4ms | $$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 | |||||
135 | Gets or sets the query opcode (the purpose of the query). | ||||
136 | |||||
137 | =cut | ||||
138 | |||||
139 | sub 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 | |||||
155 | Gets or sets the query response code (the status of the query). | ||||
156 | |||||
157 | =cut | ||||
158 | |||||
159 | sub 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 | |||||
185 | Gets or sets the query response flag. | ||||
186 | |||||
187 | =cut | ||||
188 | |||||
189 | sub 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 | |||||
199 | Gets or sets the authoritative answer flag. | ||||
200 | |||||
201 | =cut | ||||
202 | |||||
203 | sub 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 | |||||
213 | Gets or sets the truncated packet flag. | ||||
214 | |||||
215 | =cut | ||||
216 | |||||
217 | sub 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 | |||||
227 | Gets or sets the recursion desired flag. | ||||
228 | |||||
229 | =cut | ||||
230 | |||||
231 | # spent 98.9ms (53.5+45.4) within Net::DNS::Header::rd which was called 1968 times, avg 50µs/call:
# 1968 times (53.5ms+45.4ms) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 596 of Mail/SpamAssassin/DnsResolver.pm, avg 50µs/call | ||||
232 | 1968 | 25.0ms | 1968 | 45.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 | |||||
241 | Gets or sets the recursion available flag. | ||||
242 | |||||
243 | =cut | ||||
244 | |||||
245 | sub ra { | ||||
246 | shift->_dnsflag( 0x0080, @_ ); | ||||
247 | } | ||||
248 | |||||
249 | |||||
250 | =head2 z | ||||
251 | |||||
252 | Unassigned bit, should always be zero. | ||||
253 | |||||
254 | =cut | ||||
255 | |||||
256 | sub 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 | |||||
265 | Relevant in DNSSEC context. | ||||
266 | |||||
267 | (The AD bit is only set on answers where signatures have been | ||||
268 | cryptographically verified or the server is authoritative for the data | ||||
269 | and is allowed to set the bit by policy.) | ||||
270 | |||||
271 | =cut | ||||
272 | |||||
273 | sub 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 | |||||
283 | Gets or sets the checking disabled flag. | ||||
284 | |||||
285 | =cut | ||||
286 | |||||
287 | sub cd { | ||||
288 | shift->_dnsflag( 0x0010, @_ ); | ||||
289 | } | ||||
290 | |||||
291 | |||||
292 | =head2 qdcount, zocount | ||||
293 | |||||
294 | print "# of question records: ", $packet->header->qdcount, "\n"; | ||||
295 | |||||
296 | Returns the number of records in the question section of the packet. | ||||
297 | In dynamic update packets, this field is known as C<zocount> and refers | ||||
298 | to the number of RRs in the zone section. | ||||
299 | |||||
300 | =cut | ||||
301 | |||||
302 | our $warned; | ||||
303 | |||||
304 | sub 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 | |||||
315 | Returns the number of records in the answer section of the packet | ||||
316 | which may, in the case of corrupt packets, differ from the actual | ||||
317 | number of records. | ||||
318 | In dynamic update packets, this field is known as C<prcount> and refers | ||||
319 | to the number of RRs in the prerequisite section. | ||||
320 | |||||
321 | =cut | ||||
322 | |||||
323 | sub 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 | |||||
334 | Returns the number of records in the authority section of the packet | ||||
335 | which may, in the case of corrupt packets, differ from the actual | ||||
336 | number of records. | ||||
337 | In dynamic update packets, this field is known as C<upcount> and refers | ||||
338 | to the number of RRs in the update section. | ||||
339 | |||||
340 | =cut | ||||
341 | |||||
342 | sub 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 | |||||
353 | Returns the number of records in the additional section of the packet | ||||
354 | which may, in the case of corrupt packets, differ from the actual | ||||
355 | number of records. | ||||
356 | In dynamic update packets, this field is known as C<adcount>. | ||||
357 | |||||
358 | =cut | ||||
359 | |||||
360 | sub 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 | |||||
366 | sub zocount { &qdcount; } | ||||
367 | sub prcount { &ancount; } | ||||
368 | sub upcount { &nscount; } | ||||
369 | sub 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 | |||||
380 | Gets or sets the EDNS DNSSEC OK flag. | ||||
381 | |||||
382 | =cut | ||||
383 | |||||
384 | sub do { | ||||
385 | shift->_ednsflag( 0x8000, @_ ); | ||||
386 | } | ||||
387 | |||||
388 | |||||
389 | =head2 Extended rcode | ||||
390 | |||||
391 | EDNS 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 | |||||
399 | EDNS offers a mechanism to advertise the maximum UDP packet size | ||||
400 | which can be assembled by the local network stack. | ||||
401 | |||||
402 | UDP size advertisement can be viewed as either a header extension or | ||||
403 | an EDNS feature. Endless debate is avoided by supporting both views. | ||||
404 | |||||
405 | =cut | ||||
406 | |||||
407 | sub 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 | |||||
421 | Auxiliary function which provides access to the EDNS protocol | ||||
422 | extension OPT RR. | ||||
423 | |||||
424 | =cut | ||||
425 | |||||
426 | sub 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 | ||||
435 | 1968 | 3.67ms | my $self = shift; | ||
436 | 1968 | 3.56ms | my $flag = shift; | ||
437 | 1968 | 10.3ms | for ( $$self->{status} ) { | ||
438 | 1968 | 4.60ms | my $set = $_ | $flag; | ||
439 | 1968 | 4.15ms | my $not = $set - $flag; | ||
440 | 1968 | 4.39ms | $_ = (shift) ? $set : $not if scalar @_; | ||
441 | 1968 | 48.1ms | return ( $_ & $flag ) ? 1 : 0; | ||
442 | } | ||||
443 | } | ||||
444 | |||||
445 | |||||
446 | sub _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 | |||||
459 | 1 | 12µs | 1; | ||
460 | __END__ |