# $Id: 04-packet-truncate.t 1449 2016-02-01 12:27:12Z willem $ -*-perl-*-

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

use Net::DNS;
use Net::DNS::ZoneFile;

my $source = new Net::DNS::ZoneFile( \*DATA );

my @rr = $source->read;

{
	my $packet = new Net::DNS::Packet('query.example.');
	$packet->push( answer	  => @rr );
	$packet->push( authority  => @rr );
	$packet->push( additional => @rr );
	my $unlimited = length $packet->data;
	my %before    = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional);
	my $truncated = length $packet->truncate($unlimited);
	ok( $truncated == $unlimited, "unconstrained packet length $unlimited" );

	foreach my $section (qw(answer authority additional)) {
		my $before = $before{$section};
		my $after  = scalar( $packet->$section );
		is( $after, $before, "$section section unchanged, $before RRs" );
	}
	ok( !$packet->header->tc, 'header->tc flag not set' );
}


{
	my $packet = new Net::DNS::Packet('query.example.');
	$packet->push( answer	  => @rr );
	$packet->push( authority  => @rr );
	$packet->push( additional => @rr );
	my $unlimited = length $packet->data;
	my %before    = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional);
	my $truncated = length $packet->truncate;		# exercise default size
	ok( $truncated < $unlimited, "long packet was $unlimited, now $truncated" );

	foreach my $section (qw(answer authority additional)) {
		my $before = $before{$section};
		my $after  = scalar( $packet->$section );
		ok( $after < $before, "$section section was $before RRs, now $after" );
	}
	ok( $packet->header->tc, 'header->tc flag set' );
}


{
	my $packet = new Net::DNS::Packet('query.example.');
	$packet->push( answer	  => @rr );
	$packet->push( authority  => @rr );
	$packet->push( additional => @rr );

	my $tsig = eval { $packet->sign_tsig( 'tsig.example', 'ARDJZgtuTDzAWeSGYPAu9uJUkX0=' ) };

	my $unlimited = length $packet->data;
	my %before    = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional);
	my $truncated = length $packet->data(512);		# explicit minimum size
	ok( $truncated < $unlimited, "signed packet was $unlimited, now $truncated" );

	foreach my $section (qw(answer authority additional)) {
		my $before = $before{$section};
		my $after  = scalar( $packet->$section );
		ok( $after < $before, "$section section was $before RRs, now $after" );
	}
	my $sigrr = $packet->sigrr;
	is( $sigrr, $tsig, 'TSIG still in additional section' );
	ok( $packet->header->tc, 'header->tc flag set' );
}


{
	my $packet = new Net::DNS::Packet('query.example.');
	my @auth = map Net::DNS::RR->new( type => 'NS', nsdname => $_->name ), @rr;
	$packet->unique_push( authority => @auth );
	$packet->push( additional => @rr );
	$packet->edns->size(2048);				# + all bells and whistles
	my $unlimited = length $packet->data;
	my %before    = map { ( $_, scalar $packet->$_ ) } qw(answer authority additional);
	my $truncated = length $packet->truncate;
	ok( $truncated < $unlimited, "referral packet was $unlimited, now $truncated" );

	foreach my $section (qw(answer authority)) {
		my $before = $before{$section};
		my $after  = scalar( $packet->$section );
		is( $after, $before, "$section section unchanged, $before RRs" );
	}

	foreach my $section (qw(additional)) {
		my $before = $before{$section};
		my $after  = scalar( $packet->$section );
		ok( $after <= $before, "$section section was $before RRs, now $after" );
	}
	ok( !$packet->header->tc, 'header->tc flag not set' );
}


{
	my $packet = new Net::DNS::Packet('query.example.');
	$packet->push( additional => @rr, @rr );		# two of everything
	my $unlimited = length $packet->data;
	my $truncated = length $packet->truncate( $unlimited >> 1 );
	ok( $truncated, "check RRsets in truncated additional section" );

	my %rrset;
	foreach my $rr ( grep $_->type eq 'A', $packet->additional ) {
		my $name = $rr->name;
		$rrset{"$name. A"}++;
	}

	foreach my $rr ( grep $_->type eq 'AAAA', $packet->additional ) {
		my $name = $rr->name;
		$rrset{"$name. AAAA"}++;
	}

	my $expect = 2;
	foreach my $key ( sort keys %rrset ) {
		is( $rrset{$key}, $expect, "$key	; $expect RRs" );
	}
}


exit;


__DATA__

a.example.	A	198.41.0.4
a.example.	AAAA	2001:503:ba3e::2:30
b.example.	A	192.228.79.201
b.example.	AAAA	2001:500:84::b
c.example.	A	192.33.4.12
c.example.	AAAA	2001:500:2::c
d.example.	A	199.7.91.13
d.example.	AAAA	2001:500:2d::d
e.example.	A	192.203.230.10
f.example.	A	192.5.5.241
f.example.	AAAA	2001:500:2f::f
g.example.	A	192.112.36.4
h.example.	A	128.63.2.53
h.example.	AAAA	2001:500:1::803f:235
i.example.	A	192.36.148.17
i.example.	AAAA	2001:7fe::53
j.example.	A	192.58.128.30
j.example.	AAAA	2001:503:c27::2:30
k.example.	A	193.0.14.129
k.example.	AAAA	2001:7fd::1
l.example.	A	199.7.83.42
l.example.	AAAA	2001:500:3::42
m.example.	A	202.12.27.33
m.example.	AAAA	2001:dc3::35