04-packet.t   [plain text]

# $Id: 04-packet.t 704 2008-02-06 21:30:59Z olaf $	-*-perl-*-

use Test::More tests => 80;
use strict;

use Net::DNS;

my $had_xs=$Net::DNS::HAVE_XS; 


#	new() class constructor method must return object of appropriate class
isa_ok(Net::DNS::Packet->new(),	'Net::DNS::Packet',	'new() object');


#	string method returns character string representation of object
like(Net::DNS::Packet->new(undef)->string,	"/IN\tA/",	'$packet->string' );


#	Create a DNS query packet
my ($domain, $type, $class) = qw(example.test MX IN);
my $question = Net::DNS::Question->new($domain, $type, $class);

my $packet = Net::DNS::Packet->new($domain, $type, $class);
like($packet->string,	"/$class\t$type/",	'create query packet' );

ok($packet->header,	'packet->header() method works');
ok($packet->header->isa('Net::DNS::Header'),	'header() returns header object');

my @question = $packet->question;
ok(@question && @question == 1,		'packet->question() returns single element list');
my ($q) = @question;
ok($q->isa('Net::DNS::Question'),	'list element is a question object');
is_deeply($q,	$question,		'question object correct');


#	Empty packet created when new() arguments omitted
my $empty = Net::DNS::Packet->new();
ok($empty,	'create empty packet' );
foreach my $method ( qw(question answer authority additional) ) {
	my @result = $empty->$method;
	ok(@result == 0,	"$method() returns empty list");
}

#	Default question added to empty packet
my $default = Net::DNS::Question->new qw(. ANY ANY);
ok($empty->data,	'packet->data() method works');
my ($data) = $empty->question;
is_deeply($data,	$default,	'implicit question in empty packet' );


#	parse() class constructor method must return object of appropriate class
my $packet_data = $packet->data;
my $packet2 = Net::DNS::Packet->parse(\$packet_data);
isa_ok($packet2,	'Net::DNS::Packet',	'parse() object');
is_deeply($packet2->question, $packet->question, 'check question section');


#	parse() class constructor raises exception when data truncated
my $truncated = $packet->data;
while ( chop $truncated ) {
	my ($object,$error) = eval { Net::DNS::Packet->parse(\$truncated) };
	my $length = length $truncated;
	like($error,	'/exception/i',	"parse(truncated($length))");
}


#	Use push() to add RRs to each section
my $update = Net::DNS::Packet->new('.');
my $index;
foreach my $section ( qw(answer authority additional) ) {
	my $i = ++$index;
	my $rr1 = Net::DNS::RR->new(	Name	=> "$section$i.example.test",
					Type	=> "A",
					Address	=> "10.0.0.$i"
					);
	my $string1 = $rr1->string;
	my $count1 = $update->push($section, $rr1);
	like($update->string,	"/$string1/",	"push first RR into $section section");
	is($count1,	1,	"push() returns $section RR count");

	my $j = ++$index;
	my $rr2 = Net::DNS::RR->new(	Name	=> "$section$j.example.test",
					Type	=> "A",
					Address	=> "10.0.0.$j"
					);
	my $string2 = $rr2->string;
	my $count2 = $update->push($section, $rr2);
	like($update->string,	"/$string2/",	"push second RR into $section section");
	is($count2,	2,	"push() returns $section RR count");
}


#	Parse data and compare with original
my $buffer = $update->data;
my $parsed = eval { Net::DNS::Packet->parse(\$buffer) };
ok($parsed, 'parse() from data buffer works');
foreach my $count ( qw(qdcount ancount nscount arcount) ) {
	is($parsed->header->$count, $update->header->$count, "check header->$count correct");
}


foreach my $section ( qw(question answer authority additional) ) {
	my @original = map{$_->string} $update->$section;
	my @content = map{$_->string} $parsed->$section;
	is_deeply(\@content, \@original, "check content of $section section");
}


#	check that pop() removes RR from section
foreach my $section ( qw(question answer authority additional) ) {
	my $c1 = $update->push($section);
	my $rr = $update->pop($section);
	my $c2 = $update->push($section);
	is($c2,	$c1-1,	"pop() RR from $section section");
}




#	Test using a predefined answer. This is an answer that was generated by a bind server.

my $BIND = pack('H*','22cc85000001000000010001056461636874036e657400001e0001c00c0006000100000e100025026e730472697065c012046f6c6166c02a7754e1ae0000a8c0000038400005460000001c2000002910000000800000050000000030');

my $bind = Net::DNS::Packet->parse(\$BIND);

is($bind->header->qdcount, 1, 'check question count in synthetic packet header');
is($bind->header->ancount, 0, 'check answer count in synthetic packet header');
is($bind->header->nscount, 1, 'check authority count in synthetic packet header'); 
is($bind->header->adcount, 1, 'check additional count in synthetic packet header');

my ($rr) = $bind->additional;

is($rr->type,	'OPT',	'Additional section packet is EDNS0 type');
is($rr->class,	'4096',	'EDNS0 packet size correct');



#	Check dn_expand can detect data corrupted by introducing a pointer loop.
my $circular = pack('H*', '1025000000010000000000007696e76616c6964c00000010001');

SKIP: {
	skip 'No dn_expand_xs available', 1 unless $had_xs;
	my ($pkt, $error) = Net::DNS::Packet->parse(\$circular);
	like($error,	'/exception/i',	'loopdetection in dn_expand_XS');
}


# Force use of the pure-perl parser
$Net::DNS::HAVE_XS=0;
my ($pkt, $error) = Net::DNS::Packet->parse(\$circular);
like($error,	'/exception/i',	'loopdetection in dn_expand_PP');