1package Net::DNS::Header; 2 3use strict; 4use warnings; 5 6our $VERSION = (qw$Id: Header.pm 1812 2020-10-07 18:09:53Z willem $)[2]; 7 8 9=head1 NAME 10 11Net::DNS::Header - DNS packet header 12 13=head1 SYNOPSIS 14 15 use Net::DNS; 16 17 $packet = Net::DNS::Packet->new(); 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 28use integer; 29use Carp; 30 31use Net::DNS::Parameters qw(:opcode :rcode); 32 33 34=head1 METHODS 35 36 37=head2 $packet->header 38 39 $packet = Net::DNS::Packet->new(); 40 $header = $packet->header; 41 42Net::DNS::Header objects emanate from the Net::DNS::Packet header() 43method, and contain an opaque reference to the parent Packet object. 44 45Header objects may be assigned to suitably scoped lexical variables. 46They should never be stored in global variables or persistent data 47structures. 48 49 50=head2 string 51 52 print $packet->header->string; 53 54Returns a string representation of the packet header. 55 56=cut 57 58sub string { 59 my $self = shift; 60 61 my $id = $self->id; 62 my $qr = $self->qr; 63 my $opcode = $self->opcode; 64 my $rcode = $self->rcode; 65 my $qd = $self->qdcount; 66 my $an = $self->ancount; 67 my $ns = $self->nscount; 68 my $ar = $self->arcount; 69 70 my $opt = $$self->edns; 71 my $edns = $opt->_specified ? $opt->string : ''; 72 73 return <<END . $edns if $opcode eq 'UPDATE'; 74;; id = $id 75;; qr = $qr opcode = $opcode rcode = $rcode 76;; zocount = $qd prcount = $an upcount = $ns adcount = $ar 77END 78 79 my $aa = $self->aa; 80 my $tc = $self->tc; 81 my $rd = $self->rd; 82 my $ra = $self->ra; 83 my $zz = $self->z; 84 my $ad = $self->ad; 85 my $cd = $self->cd; 86 my $do = $self->do; 87 88 return <<END . $edns; 89;; id = $id 90;; qr = $qr aa = $aa tc = $tc rd = $rd opcode = $opcode 91;; ra = $ra z = $zz ad = $ad cd = $cd rcode = $rcode 92;; qdcount = $qd ancount = $an nscount = $ns arcount = $ar 93;; do = $do 94END 95} 96 97 98=head2 print 99 100 $packet->header->print; 101 102Prints the string representation of the packet header. 103 104=cut 105 106sub print { 107 print &string; 108 return; 109} 110 111 112=head2 id 113 114 print "query id = ", $packet->header->id, "\n"; 115 $packet->header->id(1234); 116 117Gets or sets the query identification number. 118 119A random value is assigned if the argument value is undefined. 120 121=cut 122 123sub id { 124 my ( $self, @arg ) = @_; 125 $$self->{id} = shift(@arg) if scalar @arg; 126 return $$self->{id} if defined $$self->{id}; 127 return $$self->{id} = int rand(0xffff); 128} 129 130 131=head2 opcode 132 133 print "query opcode = ", $packet->header->opcode, "\n"; 134 $packet->header->opcode("UPDATE"); 135 136Gets or sets the query opcode (the purpose of the query). 137 138=cut 139 140sub opcode { 141 my ( $self, $arg ) = @_; 142 my $opcode; 143 for ( $$self->{status} ) { 144 return opcodebyval( ( $_ >> 11 ) & 0x0f ) unless defined $arg; 145 $opcode = opcodebyname($arg); 146 $_ = ( $_ & 0x87ff ) | ( $opcode << 11 ); 147 } 148 return $opcode; 149} 150 151 152=head2 rcode 153 154 print "query response code = ", $packet->header->rcode, "\n"; 155 $packet->header->rcode("SERVFAIL"); 156 157Gets or sets the query response code (the status of the query). 158 159=cut 160 161sub rcode { 162 my ( $self, $arg ) = @_; 163 my $rcode; 164 for ( $$self->{status} ) { 165 my $opt = $$self->edns; 166 unless ( defined $arg ) { 167 return rcodebyval( $_ & 0x0f ) unless $opt->_specified; 168 $rcode = ( $opt->rcode & 0xff0 ) | ( $_ & 0x00f ); 169 $opt->rcode($rcode); # write back full 12-bit rcode 170 return $rcode == 16 ? 'BADVERS' : rcodebyval($rcode); 171 } 172 $rcode = rcodebyname($arg); 173 $opt->rcode($rcode); # full 12-bit rcode 174 $_ &= 0xfff0; # low 4-bit rcode 175 $_ |= ( $rcode & 0x000f ); 176 } 177 return $rcode; 178} 179 180 181=head2 qr 182 183 print "query response flag = ", $packet->header->qr, "\n"; 184 $packet->header->qr(0); 185 186Gets or sets the query response flag. 187 188=cut 189 190sub qr { 191 return shift->_dnsflag( 0x8000, @_ ); 192} 193 194 195=head2 aa 196 197 print "response is ", $packet->header->aa ? "" : "non-", "authoritative\n"; 198 $packet->header->aa(0); 199 200Gets or sets the authoritative answer flag. 201 202=cut 203 204sub aa { 205 return shift->_dnsflag( 0x0400, @_ ); 206} 207 208 209=head2 tc 210 211 print "packet is ", $packet->header->tc ? "" : "not ", "truncated\n"; 212 $packet->header->tc(0); 213 214Gets or sets the truncated packet flag. 215 216=cut 217 218sub tc { 219 return shift->_dnsflag( 0x0200, @_ ); 220} 221 222 223=head2 rd 224 225 print "recursion was ", $packet->header->rd ? "" : "not ", "desired\n"; 226 $packet->header->rd(0); 227 228Gets or sets the recursion desired flag. 229 230=cut 231 232sub rd { 233 return shift->_dnsflag( 0x0100, @_ ); 234} 235 236 237=head2 ra 238 239 print "recursion is ", $packet->header->ra ? "" : "not ", "available\n"; 240 $packet->header->ra(0); 241 242Gets or sets the recursion available flag. 243 244=cut 245 246sub ra { 247 return shift->_dnsflag( 0x0080, @_ ); 248} 249 250 251=head2 z 252 253Unassigned bit, should always be zero. 254 255=cut 256 257sub z { 258 return shift->_dnsflag( 0x0040, @_ ); 259} 260 261 262=head2 ad 263 264 print "The response has ", $packet->header->ad ? "" : "not", "been verified\n"; 265 266Relevant in DNSSEC context. 267 268(The AD bit is only set on a response where signatures have been 269cryptographically verified or the server is authoritative for the data 270and is allowed to set the bit by policy.) 271 272=cut 273 274sub ad { 275 return shift->_dnsflag( 0x0020, @_ ); 276} 277 278 279=head2 cd 280 281 print "checking was ", $packet->header->cd ? "not" : "", "desired\n"; 282 $packet->header->cd(0); 283 284Gets or sets the checking disabled flag. 285 286=cut 287 288sub cd { 289 return shift->_dnsflag( 0x0010, @_ ); 290} 291 292 293=head2 qdcount, zocount 294 295 print "# of question records: ", $packet->header->qdcount, "\n"; 296 297Returns the number of records in the question section of the packet. 298In dynamic update packets, this field is known as C<zocount> and refers 299to the number of RRs in the zone section. 300 301=cut 302 303our $warned; 304 305sub qdcount { 306 my $self = shift; 307 return $$self->{count}[0] || scalar @{$$self->{question}} unless scalar @_; 308 carp 'header->qdcount attribute is read-only' unless $warned++; 309 return; 310} 311 312 313=head2 ancount, prcount 314 315 print "# of answer records: ", $packet->header->ancount, "\n"; 316 317Returns the number of records in the answer section of the packet 318which may, in the case of corrupt packets, differ from the actual 319number of records. 320In dynamic update packets, this field is known as C<prcount> and refers 321to the number of RRs in the prerequisite section. 322 323=cut 324 325sub ancount { 326 my $self = shift; 327 return $$self->{count}[1] || scalar @{$$self->{answer}} unless scalar @_; 328 carp 'header->ancount attribute is read-only' unless $warned++; 329 return; 330} 331 332 333=head2 nscount, upcount 334 335 print "# of authority records: ", $packet->header->nscount, "\n"; 336 337Returns the number of records in the authority section of the packet 338which may, in the case of corrupt packets, differ from the actual 339number of records. 340In dynamic update packets, this field is known as C<upcount> and refers 341to the number of RRs in the update section. 342 343=cut 344 345sub nscount { 346 my $self = shift; 347 return $$self->{count}[2] || scalar @{$$self->{authority}} unless scalar @_; 348 carp 'header->nscount attribute is read-only' unless $warned++; 349 return; 350} 351 352 353=head2 arcount, adcount 354 355 print "# of additional records: ", $packet->header->arcount, "\n"; 356 357Returns the number of records in the additional section of the packet 358which may, in the case of corrupt packets, differ from the actual 359number of records. 360In dynamic update packets, this field is known as C<adcount>. 361 362=cut 363 364sub arcount { 365 my $self = shift; 366 return $$self->{count}[3] || scalar @{$$self->{additional}} unless scalar @_; 367 carp 'header->arcount attribute is read-only' unless $warned++; 368 return; 369} 370 371sub zocount { return &qdcount; } 372sub prcount { return &ancount; } 373sub upcount { return &nscount; } 374sub adcount { return &arcount; } 375 376 377=head1 EDNS Protocol Extensions 378 379 380=head2 do 381 382 print "DNSSEC_OK flag was ", $packet->header->do ? "not" : "", "set\n"; 383 $packet->header->do(1); 384 385Gets or sets the EDNS DNSSEC OK flag. 386 387=cut 388 389sub do { 390 return shift->_ednsflag( 0x8000, @_ ); 391} 392 393 394=head2 Extended rcode 395 396EDNS extended rcodes are handled transparently by $packet->header->rcode(). 397 398 399=head2 UDP packet size 400 401 $udp_max = $packet->header->size; 402 $udp_max = $packet->edns->size; 403 404EDNS offers a mechanism to advertise the maximum UDP packet size 405which can be assembled by the local network stack. 406 407UDP size advertisement can be viewed as either a header extension or 408an EDNS feature. Endless debate is avoided by supporting both views. 409 410=cut 411 412sub size { 413 my $self = shift; 414 return $$self->edns->size(@_); 415} 416 417 418=head2 edns 419 420 $header = $packet->header; 421 $version = $header->edns->version; 422 @options = $header->edns->options; 423 $option = $header->edns->option(n); 424 $udp_max = $packet->edns->size; 425 426Auxiliary function which provides access to the EDNS protocol 427extension OPT RR. 428 429=cut 430 431sub edns { 432 my $self = shift; 433 return $$self->edns; 434} 435 436 437######################################## 438 439sub _dnsflag { 440 my $self = shift; 441 my $flag = shift; 442 for ( $$self->{status} ) { 443 my $set = $_ | $flag; 444 my $not = $set - $flag; 445 $_ = (shift) ? $set : $not if scalar @_; 446 $flag = ( $_ & $flag ) ? 1 : 0; 447 } 448 return $flag; 449} 450 451 452sub _ednsflag { 453 my ( $self, $flag, @val ) = @_; 454 my $edns = $$self->edns->flags || 0; 455 return $flag & $edns ? 1 : 0 unless scalar @val; 456 my $set = $flag | $edns; 457 my $not = $set - $flag; 458 my $val = shift(@val) ? $set : $not; 459 $$self->edns->flags($val) unless $val == $edns; 460 return ( $val & $flag ) ? 1 : 0; 461} 462 463 4641; 465__END__ 466 467 468######################################## 469 470=head1 COPYRIGHT 471 472Copyright (c)1997 Michael Fuhr. 473 474Portions Copyright (c)2002,2003 Chris Reinhardt. 475 476Portions Copyright (c)2012 Dick Franks. 477 478All rights reserved. 479 480 481=head1 LICENSE 482 483Permission to use, copy, modify, and distribute this software and its 484documentation for any purpose and without fee is hereby granted, provided 485that the above copyright notice appear in all copies and that both that 486copyright notice and this permission notice appear in supporting 487documentation, and that the name of the author not be used in advertising 488or publicity pertaining to distribution of the software without specific 489prior written permission. 490 491THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 492IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 493FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 494THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 495LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 496FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 497DEALINGS IN THE SOFTWARE. 498 499 500=head1 SEE ALSO 501 502L<perl>, L<Net::DNS>, L<Net::DNS::Packet>, L<Net::DNS::RR::OPT> 503RFC 1035 Section 4.1.1 504 505=cut 506 507