1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
# $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');
|
