1package Net::DNS::Header; 2# 3# $Id: Header.pm 704 2008-02-06 21:30:59Z olaf $ 4# 5 6use strict; 7 8BEGIN { 9 eval { require bytes; } 10} 11 12 13use vars qw($VERSION $AUTOLOAD); 14 15use Carp; 16use Net::DNS; 17 18use constant MAX_ID => 65535; 19 20$VERSION = (qw$LastChangedRevision: 704 $)[1]; 21 22=head1 NAME 23 24Net::DNS::Header - DNS packet header class 25 26=head1 SYNOPSIS 27 28C<use Net::DNS::Header;> 29 30=head1 DESCRIPTION 31 32A C<Net::DNS::Header> object represents the header portion of a DNS 33packet. 34 35=head1 METHODS 36 37=head2 new 38 39 $header = Net::DNS::Header->new; 40 41C<new> creates a header object appropriate for making a DNS query. 42 43=cut 44 45{ 46 sub nextid { 47 int rand(MAX_ID); 48 } 49} 50 51sub new { 52 my $class = shift; 53 54 my $self = { id => nextid(), 55 qr => 0, 56 opcode => $Net::DNS::opcodesbyval{0}, 57 aa => 0, 58 tc => 0, 59 rd => 1, 60 ra => 0, 61 ad => 0, 62 cd => 0, 63 rcode => $Net::DNS::rcodesbyval{0}, 64 qdcount => 0, 65 ancount => 0, 66 nscount => 0, 67 arcount => 0, 68 }; 69 70 bless $self, $class; 71} 72 73 74=head2 parse 75 76 ($header, $offset) = Net::DNS::Header->parse(\$data); 77 78Parses the header record at the start of a DNS packet. 79The argument is a reference to the packet data. 80 81Returns a Net::DNS::Header object and the offset of the next location 82in the packet. 83 84Parsing is aborted if the header object cannot be created (e.g., 85corrupt or insufficient data). 86 87=cut 88 89use constant PACKED_LENGTH => length pack 'n C2 n4', (0)x7; 90 91sub parse { 92 my ($class, $data) = @_; 93 94 die 'Exception: incomplete data' if length($$data) < PACKED_LENGTH; 95 96 my ($id, $b2, $b3, $qd, $an, $ns, $ar) = unpack('n C2 n4', $$data); 97 98 my $opval = ($b2 >> 3) & 0xf; 99 my $opcode = $Net::DNS::opcodesbyval{$opval} || $opval; 100 my $rval = $b3 & 0xf; 101 my $rcode = $Net::DNS::rcodesbyval{$rval} || $rval; 102 103 my $self = { id => $id, 104 qr => ($b2 >> 7) & 0x1, 105 opcode => $opcode, 106 aa => ($b2 >> 2) & 0x1, 107 tc => ($b2 >> 1) & 0x1, 108 rd => $b2 & 0x1, 109 ra => ($b3 >> 7) & 0x1, 110 ad => ($b3 >> 5) & 0x1, 111 cd => ($b3 >> 4) & 0x1, 112 rcode => $rcode, 113 qdcount => $qd, 114 ancount => $an, 115 nscount => $ns, 116 arcount => $ar 117 }; 118 119 bless $self, $class; 120 121 return wantarray ? ($self, PACKED_LENGTH) : $self; 122} 123 124# 125# Some people have reported that Net::DNS dies because AUTOLOAD picks up 126# calls to DESTROY. 127# 128sub DESTROY {} 129 130=head2 print 131 132 $header->print; 133 134Prints the header record on the standard output. 135 136=cut 137 138sub print { print &string, "\n"; } 139 140=head2 string 141 142 print $header->string; 143 144Returns a string representation of the header object. 145 146=cut 147 148sub string { 149 my $self = shift; 150 my $retval = ""; 151 152 $retval .= ";; id = $self->{id}\n"; 153 154 if ($self->{"opcode"} eq "UPDATE") { 155 $retval .= ";; qr = $self->{qr} " . 156 "opcode = $self->{opcode} " . 157 "rcode = $self->{rcode}\n"; 158 159 $retval .= ";; zocount = $self->{qdcount} " . 160 "prcount = $self->{ancount} " . 161 "upcount = $self->{nscount} " . 162 "adcount = $self->{arcount}\n"; 163 } 164 else { 165 $retval .= ";; qr = $self->{qr} " . 166 "opcode = $self->{opcode} " . 167 "aa = $self->{aa} " . 168 "tc = $self->{tc} " . 169 "rd = $self->{rd}\n"; 170 171 $retval .= ";; ra = $self->{ra} " . 172 "ad = $self->{ad} " . 173 "cd = $self->{cd} " . 174 "rcode = $self->{rcode}\n"; 175 176 $retval .= ";; qdcount = $self->{qdcount} " . 177 "ancount = $self->{ancount} " . 178 "nscount = $self->{nscount} " . 179 "arcount = $self->{arcount}\n"; 180 } 181 182 return $retval; 183} 184 185=head2 id 186 187 print "query id = ", $header->id, "\n"; 188 $header->id(1234); 189 190Gets or sets the query identification number. 191 192=head2 qr 193 194 print "query response flag = ", $header->qr, "\n"; 195 $header->qr(0); 196 197Gets or sets the query response flag. 198 199=head2 opcode 200 201 print "query opcode = ", $header->opcode, "\n"; 202 $header->opcode("UPDATE"); 203 204Gets or sets the query opcode (the purpose of the query). 205 206=head2 aa 207 208 print "answer is ", $header->aa ? "" : "non-", "authoritative\n"; 209 $header->aa(0); 210 211Gets or sets the authoritative answer flag. 212 213=head2 tc 214 215 print "packet is ", $header->tc ? "" : "not ", "truncated\n"; 216 $header->tc(0); 217 218Gets or sets the truncated packet flag. 219 220=head2 rd 221 222 print "recursion was ", $header->rd ? "" : "not ", "desired\n"; 223 $header->rd(0); 224 225Gets or sets the recursion desired flag. 226 227 228=head2 cd 229 230 print "checking was ", $header->cd ? "not" : "", "desired\n"; 231 $header->cd(0); 232 233Gets or sets the checking disabled flag. 234 235 236 237=head2 ra 238 239 print "recursion is ", $header->ra ? "" : "not ", "available\n"; 240 $header->ra(0); 241 242Gets or sets the recursion available flag. 243 244 245=head2 ad 246 247 print "The result has ", $header->ad ? "" : "not", "been verified\n" 248 249 250Relevant in DNSSEC context. 251 252(The AD bit is only set on answers where signatures have been 253cryptographically verified or the server is authoritative for the data 254and is allowed to set the bit by policy.) 255 256 257=head2 rcode 258 259 print "query response code = ", $header->rcode, "\n"; 260 $header->rcode("SERVFAIL"); 261 262Gets or sets the query response code (the status of the query). 263 264=head2 qdcount, zocount 265 266 print "# of question records: ", $header->qdcount, "\n"; 267 $header->qdcount(2); 268 269Gets or sets the number of records in the question section of the packet. 270In dynamic update packets, this field is known as C<zocount> and refers 271to the number of RRs in the zone section. 272 273=head2 ancount, prcount 274 275 print "# of answer records: ", $header->ancount, "\n"; 276 $header->ancount(5); 277 278Gets or sets the number of records in the answer section of the packet. 279In dynamic update packets, this field is known as C<prcount> and refers 280to the number of RRs in the prerequisite section. 281 282=head2 nscount, upcount 283 284 print "# of authority records: ", $header->nscount, "\n"; 285 $header->nscount(2); 286 287Gets or sets the number of records in the authority section of the packet. 288In dynamic update packets, this field is known as C<upcount> and refers 289to the number of RRs in the update section. 290 291=head2 arcount, adcount 292 293 print "# of additional records: ", $header->arcount, "\n"; 294 $header->arcount(3); 295 296Gets or sets the number of records in the additional section of the packet. 297In dynamic update packets, this field is known as C<adcount>. 298 299=cut 300 301sub zocount { &qdcount; } 302sub prcount { &ancount; } 303sub upcount { &nscount; } 304sub adcount { &arcount; } 305 306 307sub AUTOLOAD { 308 my $self = shift; 309 310 my $name = $AUTOLOAD; 311 $name =~ s/.*://o; 312 313 croak "$AUTOLOAD: no such method" unless exists $self->{$name}; 314 315 return $self->{$name} unless @_; 316 317 my $value = shift; 318 $self->{$name} = $value; 319} 320 321 322=head2 data 323 324 $hdata = $header->data; 325 326Returns the header data in binary format, appropriate for use in a 327DNS query packet. 328 329=cut 330 331sub data { 332 my $self = shift; 333 334 my $opcode = $Net::DNS::opcodesbyname{ $self->{opcode} }; 335 my $rcode = $Net::DNS::rcodesbyname{ $self->{rcode} }; 336 337 my $byte2 = ($self->{qr} ? 0x80 : 0) 338 | ($opcode << 3) 339 | ($self->{aa} ? 0x04 : 0) 340 | ($self->{tc} ? 0x02 : 0) 341 | ($self->{rd} ? 0x01 : 0); 342 343 my $byte3 = ($self->{ra} ? 0x80 : 0) 344 | ($self->{ad} ? 0x20 : 0) 345 | ($self->{cd} ? 0x10 : 0) 346 | ($rcode || 0); 347 348 pack('n C2 n4', $self->{id}, $byte2, $byte3, 349 map{$self->{$_} || 0} qw(qdcount ancount nscount arcount) ); 350} 351 352=head1 COPYRIGHT 353 354Copyright (c) 1997-2002 Michael Fuhr. 355 356Portions Copyright (c) 2002-2004 Chris Reinhardt. 357 358Portions Copyright (c) 2007 Dick Franks. 359 360All rights reserved. This program is free software; you may redistribute 361it and/or modify it under the same terms as Perl itself. 362 363=head1 SEE ALSO 364 365L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>, 366L<Net::DNS::Update>, L<Net::DNS::Question>, L<Net::DNS::RR>, 367RFC 1035 Section 4.1.1 368 369=cut 370 3711; 372