package Net::DNS::Header;

use strict;
use vars qw($VERSION $AUTOLOAD);

use Net::DNS;

# $Id: Header.pm,v 1.8 2000/11/19 05:53:56 mfuhr Exp mfuhr $
$VERSION = $Net::DNS::VERSION;

=head1 NAME

Net::DNS::Header - DNS packet header class

=head1 SYNOPSIS

C<use Net::DNS::Header;>

=head1 DESCRIPTION

A C<Net::DNS::Header> object represents the header portion of a DNS
packet.

=head1 METHODS

=head2 new

    $header = Net::DNS::Header->new;
    $header = Net::DNS::Header->new(\$data);

Without an argument, C<new> creates a header object appropriate
for making a DNS query.

If C<new> is passed a reference to a scalar containing DNS packet
data, it creates a header object from that data.

Returns B<undef> if unable to create a header object (e.g., if
the data is incomplete).

=cut

sub new {
	my $class = shift;
	my %self;

	if (@_) {
		my $data = shift;

		if (length($$data) < &Net::DNS::HFIXEDSZ) {
			return undef;
		}

		my @a = unpack("n C2 n4", $$data);
		%self = (
			"id"		=> $a[0],
			"qr"		=> ($a[1] >> 7) & 0x1,
			"opcode"	=> ($a[1] >> 3) & 0xf,
			"aa"		=> ($a[1] >> 2) & 0x1,
			"tc"		=> ($a[1] >> 1) & 0x1,
			"rd"		=> $a[1] & 0x1,
			"ra"		=> ($a[2] >> 7) & 0x1,
			"rcode"		=> $a[2] & 0xf,
			"qdcount"	=> $a[3],
			"ancount"	=> $a[4],
			"nscount"	=> $a[5],
			"arcount"	=> $a[6],
		);
	}
	else {
		%self = (
			"id"		=> Net::DNS::Resolver::nextid(),
			"qr"		=> 0,
			"opcode"	=> 0,
			"aa"		=> 0,
			"tc"		=> 0,
			"rd"		=> 1,
			"ra"		=> 0,
			"rcode"		=> 0,
			"qdcount"	=> 1,
			"ancount"	=> 0,
			"nscount"	=> 0,
			"arcount"	=> 0,
		);
	}

	$self{"opcode"} = $Net::DNS::opcodesbyval{$self{"opcode"}}
		if exists $Net::DNS::opcodesbyval{$self{"opcode"}};
	$self{"rcode"} = $Net::DNS::rcodesbyval{$self{"rcode"}}
		if exists $Net::DNS::rcodesbyval{$self{"rcode"}};

	return bless \%self, $class;
}

#
# Some people have reported that Net::DNS dies because AUTOLOAD picks up
# calls to DESTROY.
#
sub DESTROY {}

=head2 print

    $header->print;

Dumps the header data to the standard output.

=cut

sub print {
	my $self = shift;
	print $self->string;
}

=head2 string

    print $header->string;

Returns a string representation of the header object.

=cut

sub string {
	my $self = shift;
	my $retval = "";

	$retval .= ";; id = $self->{id}\n";

	if ($self->{"opcode"} eq "UPDATE") {
		$retval .= ";; qr = $self->{qr}    "      .
		           "opcode = $self->{opcode}    " .
		           "rcode = $self->{rcode}\n";

		$retval .= ";; zocount = $self->{qdcount}  " .
		           "prcount = $self->{ancount}  "    .
		           "upcount = $self->{nscount}  "    .
		           "adcount = $self->{arcount}\n";
	}
	else {
		$retval .= ";; qr = $self->{qr}    "      .
		           "opcode = $self->{opcode}    " .
		           "aa = $self->{aa}    "         .
		           "tc = $self->{tc}    "         .
		           "rd = $self->{rd}\n";

		$retval .= ";; ra = $self->{ra}    " .
		           "rcode  = $self->{rcode}\n";

		$retval .= ";; qdcount = $self->{qdcount}  " .
		           "ancount = $self->{ancount}  "    .
		           "nscount = $self->{nscount}  "    .
		           "arcount = $self->{arcount}\n";
	}

	return $retval;
}

=head2 id

    print "query id = ", $header->id, "\n";
    $header->id(1234);

Gets or sets the query identification number.

=head2 qr

    print "query response flag = ", $header->qr, "\n";
    $header->qr(0);

Gets or sets the query response flag.

=head2 opcode

    print "query opcode = ", $header->opcode, "\n";
    $header->opcode("UPDATE");

Gets or sets the query opcode (the purpose of the query).

=head2 aa

    print "answer is ", $header->aa ? "" : "non-", "authoritative\n";
    $header->aa(0);

Gets or sets the authoritative answer flag.

=head2 tc

    print "packet is ", $header->tc ? "" : "not ", "truncated\n";
    $header->tc(0);

Gets or sets the truncated packet flag.

=head2 rd

    print "recursion was ", $header->rd ? "" : "not ", "desired\n";
    $header->rd(0);

Gets or sets the recursion desired flag.

=head2 ra

    print "recursion is ", $header->ra ? "" : "not ", "available\n";
    $header->ra(0);

Gets or sets the recursion available flag.

=head2 rcode

    print "query response code = ", $header->rcode, "\n";
    $header->rcode("SERVFAIL");

Gets or sets the query response code (the status of the query).

=head2 qdcount, zocount

    print "# of question records: ", $header->qdcount, "\n";
    $header->qdcount(2);

Gets or sets the number of records in the question section of the packet.
In dynamic update packets, this field is known as C<zocount> and refers
to the number of RRs in the zone section.

=head2 ancount, prcount

    print "# of answer records: ", $header->ancount, "\n";
    $header->ancount(5);

Gets or sets the number of records in the answer section of the packet.
In dynamic update packets, this field is known as C<prcount> and refers
to the number of RRs in the prerequisite section.

=head2 nscount, upcount

    print "# of authority records: ", $header->nscount, "\n";
    $header->nscount(2);

Gets or sets the number of records in the authority section of the packet.
In dynamic update packets, this field is known as C<upcount> and refers
to the number of RRs in the update section.

=head2 arcount, adcount

    print "# of additional records: ", $header->arcount, "\n";
    $header->arcount(3);

Gets or sets the number of records in the additional section of the packet.
In dynamic update packets, this field is known as C<adcount>.

=cut

sub AUTOLOAD {
	my $self = shift;
	my $name = $AUTOLOAD;
	$name =~ s/.*://;

	Carp::confess "$name: no such method"
		unless exists $self->{$name};

	$self->{$name} = shift if @_;
	return $self->{$name};
}

sub zocount { my $self = shift; $self->qdcount(@_); }
sub prcount { my $self = shift; $self->ancount(@_); }
sub upcount { my $self = shift; $self->nscount(@_); }
sub adcount { my $self = shift; $self->arcount(@_); }

=head2 data

    $hdata = $header->data;

Returns the header data in binary format, appropriate for use in a
DNS query packet.

=cut

sub data {
	my $self = shift;

	my $opcode = $Net::DNS::opcodesbyname{$self->{"opcode"}};
	my $rcode  = $Net::DNS::rcodesbyname{$self->{"rcode"}};

	my $byte2 = ($self->{"qr"} << 7)
	          | ($opcode << 3)
	          | ($self->{"aa"} << 2)
	          | ($self->{"tc"} << 1)
	          | $self->{"rd"};

	my $byte3 = ($self->{"ra"} << 7)
	          | $rcode;

	return pack("n C2 n4", $self->{"id"},
			       $byte2,
			       $byte3,
			       $self->{"qdcount"},
			       $self->{"ancount"},
			       $self->{"nscount"},
			       $self->{"arcount"});
}

=head1 COPYRIGHT

Copyright (c) 1997-2000 Michael Fuhr.  All rights reserved.  This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. 

=head1 SEE ALSO

L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
L<Net::DNS::Update>, L<Net::DNS::Question>, L<Net::DNS::RR>,
RFC 1035 Section 4.1.1

=cut

1;