# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..15\n"; }
END {print "not ok 1\n" unless $loaded;}
#use diagnostics;
use Net::DNS::ToolKit qw(
put16
get1char
parse_char
newhead
dn_comp
put_qdcount
);
use Net::DNS::ToolKit::Debug qw(
print_head
print_buf
);
use Net::DNS::Codes qw(:all);
my $module = ($0 =~ /([A-Z]+)\.t$/)
? 'Net::DNS::ToolKit::RR::'.$1
: 'Net::DNS::ToolKit::RR::TXT';
eval "require $module";
# skip some tests for these modules
my @skip = qw(
HINFO
);
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
$test = 2;
sub ok {
print "ok $test\n";
++$test;
}
## test 2 setup, generate a header for a question
my $buffer = '';
my $off = newhead(\$buffer,
12345, # id
QR | BITS_QUERY | RD | RA, # query response, query, recursion desired, recursion available
);
print "bad question size $off\nnot "
unless $off == NS_HFIXEDSZ;
&ok;
sub expect {
my $x = shift;
my @exp;
foreach(split(/\n/,$x)) {
if ($_ =~ /0x\w+\s+(\d+) /) {
push @exp,$1;
}
}
return @exp;
}
sub print_ptrs {
foreach(@_) {
print "$_ ";
}
print "\n";
}
sub chk_exp {
my($bp,$exp) = @_;
my @expect = expect($$exp);
my $len = length($$bp);
if ($len == @expect) {
foreach(0..$len -1) {
$char = get1char($bp,$_);
next if $char == $expect[$_];
print "buffer mismatch $_, got: $char, exp: $expect[$_]\nnot ";
last;
}
} else {
print "bad buffer length $len, exp: ",scalar @expect,"\nnot ";
}
&ok;
}
## test 3 setup, append question
# expect this from print_buf
my $exptext = q(
0 : 0011_0000 0x30 48 0
1 : 0011_1001 0x39 57 9
2 : 1000_0001 0x81 129
3 : 1000_0000 0x80 128
4 : 0000_0000 0x00 0
5 : 0000_0001 0x01 1
6 : 0000_0000 0x00 0
7 : 0000_0000 0x00 0
8 : 0000_0000 0x00 0
9 : 0000_0000 0x00 0
10 : 0000_0000 0x00 0
11 : 0000_0000 0x00 0
12 : 0000_0011 0x03 3
13 : 0110_0110 0x66 102 f
14 : 0110_1111 0x6F 111 o
15 : 0110_1111 0x6F 111 o
16 : 0000_0011 0x03 3
17 : 0110_0010 0x62 98 b
18 : 0110_0001 0x61 97 a
19 : 0111_0010 0x72 114 r
20 : 0000_0011 0x03 3
21 : 0110_0011 0x63 99 c
22 : 0110_1111 0x6F 111 o
23 : 0110_1101 0x6D 109 m
24 : 0000_0000 0x00 0
25 : 0000_0000 0x00 0
26 : 0000_0001 0x01 16
27 : 0000_0000 0x00 0
28 : 0000_0001 0x01 1
);
my $name = 'foo.bar.com';
my @dnptrs;
($off,@dnptrs)=dn_comp(\$buffer,$off,\$name);
# push on some stuff that looks like a question
$off = put16(\$buffer,$off,T_TXT);
$off = put16(\$buffer,$off,C_IN);
put_qdcount(\$buffer,1);
#print_head(\$buffer);
#print_buf(\$buffer);
#print_ptrs(@dnptrs);
chk_exp(\$buffer,\$exptext);
#######################################
## test 4 put TXT record
# This is what we must test
# ($newoff,$name,$type,$class,$ttl,$rdlength,
# $rdata,...) = $get->XYZ(\$buffer,$offset);
#
# ($newoff,@dnptrs)=$put->XYZ(\$buffer,$offset,\@dnptrs,
# $name,$type,$class,$ttl,$rdlength,$rdata,...);
#
# $name,$TYPE,$CLASS,$TTL,$rdlength,$IPaddr)
# = $parse->XYZ($name,$type,$class,$ttl,$rdlength,
# $rdata,...);
$exptext = q(
0 : 0011_0000 0x30 48 0
1 : 0011_1001 0x39 57 9
2 : 1000_0001 0x81 129
3 : 1000_0000 0x80 128
4 : 0000_0000 0x00 0
5 : 0000_0001 0x01 1
6 : 0000_0000 0x00 0
7 : 0000_0000 0x00 0
8 : 0000_0000 0x00 0
9 : 0000_0000 0x00 0
10 : 0000_0000 0x00 0
11 : 0000_0000 0x00 0
12 : 0000_0011 0x03 3
13 : 0110_0110 0x66 102 f
14 : 0110_1111 0x6F 111 o
15 : 0110_1111 0x6F 111 o
16 : 0000_0011 0x03 3
17 : 0110_0010 0x62 98 b
18 : 0110_0001 0x61 97 a
19 : 0111_0010 0x72 114 r
20 : 0000_0011 0x03 3
21 : 0110_0011 0x63 99 c
22 : 0110_1111 0x6F 111 o
23 : 0110_1101 0x6D 109 m
24 : 0000_0000 0x00 0
25 : 0000_0000 0x00 0
26 : 0001_0000 0x10 16
27 : 0000_0000 0x00 0
28 : 0000_0001 0x01 1
29 : 0000_0000 0x00 0
30 : 0010_1101 0x2D 45 -
31 : 0010_1100 0x2C 44 ,
32 : 0101_0100 0x54 84 T
33 : 0110_1000 0x68 104 h
34 : 0110_0101 0x65 101 e
35 : 0010_0000 0x20 32
36 : 0101_0001 0x51 81 Q
37 : 0111_0101 0x75 117 u
38 : 0110_1001 0x69 105 i
39 : 0110_0011 0x63 99 c
40 : 0110_1011 0x6B 107 k
41 : 0010_0000 0x20 32
42 : 0100_0010 0x42 66 B
43 : 0111_0010 0x72 114 r
44 : 0110_1111 0x6F 111 o
45 : 0111_0111 0x77 119 w
46 : 0110_1110 0x6E 110 n
47 : 0010_0000 0x20 32
48 : 0100_0110 0x46 70 F
49 : 0110_1111 0x6F 111 o
50 : 0111_1000 0x78 120 x
51 : 0010_0000 0x20 32
52 : 0100_1010 0x4A 74 J
53 : 0111_0101 0x75 117 u
54 : 0110_1101 0x6D 109 m
55 : 0111_0000 0x70 112 p
56 : 0110_0101 0x65 101 e
57 : 0110_0100 0x64 100 d
58 : 0010_0000 0x20 32
59 : 0100_1111 0x4F 79 O
60 : 0111_0110 0x76 118 v
61 : 0110_0101 0x65 101 e
62 : 0111_0010 0x72 114 r
63 : 0010_0000 0x20 32
64 : 0111_0100 0x74 116 t
65 : 0110_1000 0x68 104 h
66 : 0110_0101 0x65 101 e
67 : 0010_0000 0x20 32
68 : 0100_1100 0x4C 76 L
69 : 0110_0001 0x61 97 a
70 : 0111_1010 0x7A 122 z
71 : 0111_1001 0x79 121 y
72 : 0010_0000 0x20 32
73 : 0100_0100 0x44 68 D
74 : 0110_1111 0x6F 111 o
75 : 0110_0111 0x67 103 g
);
my $txt = 'The Quick Brown Fox Jumped Over the Lazy Dog';
### offset from above = 29
my $newoff;
if (grep($module =~ /$_$/, @skip)) {
print "Skipped... not needed this RR\n";
&ok;
} else {
($newoff, @dnptrs) = $module->put(\$buffer,$off,\@dnptrs,$txt);
# print_buf(\$buffer);
# print_ptrs(@dnptrs);
chk_exp(\$buffer,\$exptext);
$off = $newoff;
}
## test 5 test get
my $start = 29; # from above
# check offset against PUT operation above
if (grep($module =~ /$_$/, @skip)) {
print "Skipped... not needed this RR\n";
} else {
($newoff,$newtxt) = $module->get(\$buffer,$start);
print "bad offset, $newoff, exp: $off\nnot "
unless $newoff == $off;
}
&ok;
## test 6 verify text
if (grep($module =~ /$_$/, @skip)) {
print "Skipped... not needed this RR\n";
} else {
print "bad text\ngot: $newtxt\nexp: $txt\nnot "
unless $newtxt eq $txt;
}
&ok;
## test 7 check parse
my $input = 'the quick brown fox jumped over the lazy dog';
print "bad parse\n got: $_\nexp: $input\nnot "
unless ($_ = $module->parse($input)) eq '"'.$input.'"';
&ok;
## test 8 check inheritance
my $inherit = $module . '::parse';
print "inheritance failed\n got: $_\nexp: $input\nnot "
unless ($_ = &$inherit($module,$input)) eq '"'.$input.'"';
&ok;
## test 9 setup, generate a new header for a question
$buffer = '';
$off = newhead(\$buffer,
12345, # id
QR | BITS_QUERY | RD | RA, # query response, query, recursion desired, recursion available
);
$name = 'bar.com';
($off,@dnptrs)=dn_comp(\$buffer,$off,\$name);
# push on some stuff that looks like a question
$off = put16(\$buffer,$off,T_TXT);
$off = put16(\$buffer,$off,C_IN);
put_qdcount(\$buffer,1);
my @txt = qw(hello goodbye);
($newoff, @dnptrs) = $module->put(\$buffer,$off,\@dnptrs,@txt);
$exptext = q|
0 : 0011_0000 0x30 48 0
1 : 0011_1001 0x39 57 9
2 : 1000_0001 0x81 129
3 : 1000_0000 0x80 128
4 : 0000_0000 0x00 0
5 : 0000_0001 0x01 1
6 : 0000_0000 0x00 0
7 : 0000_0000 0x00 0
8 : 0000_0000 0x00 0
9 : 0000_0000 0x00 0
10 : 0000_0000 0x00 0
11 : 0000_0000 0x00 0
12 : 0000_0011 0x03 3
13 : 0110_0010 0x62 98 b
14 : 0110_0001 0x61 97 a
15 : 0111_0010 0x72 114 r
16 : 0000_0011 0x03 3
17 : 0110_0011 0x63 99 c
18 : 0110_1111 0x6F 111 o
19 : 0110_1101 0x6D 109 m
20 : 0000_0000 0x00 0
21 : 0000_0000 0x00 0
22 : 0001_0000 0x10 16
23 : 0000_0000 0x00 0
24 : 0000_0001 0x01 1
25 : 0000_0000 0x00 0
26 : 0000_1110 0x0E 14
27 : 0000_0101 0x05 5
28 : 0110_1000 0x68 104 h
29 : 0110_0101 0x65 101 e
30 : 0110_1100 0x6C 108 l
31 : 0110_1100 0x6C 108 l
32 : 0110_1111 0x6F 111 o
33 : 0000_0111 0x07 7
34 : 0110_0111 0x67 103 g
35 : 0110_1111 0x6F 111 o
36 : 0110_1111 0x6F 111 o
37 : 0110_0100 0x64 100 d
38 : 0110_0010 0x62 98 b
39 : 0111_1001 0x79 121 y
40 : 0110_0101 0x65 101 e
|;
#print_buf(\$buffer);
#print_ptrs(@dnptrs);
chk_exp(\$buffer,\$exptext);
## test 10 # test get
$off = $newoff;
$start = 25; # from above
($newoff,my @newtxt) = $module->get(\$buffer,$start);
# check offset against PUT operation above
print "bad offset, $newoff, exp: $off\nnot "
unless $newoff == $off;
&ok;
## test 11 verify same number of strings
print "bad string count: ", scalar @newtxt,", exp: ",scalar @txt,"\nnot "
unless @newtxt == @txt;
&ok;
## test 12-13 verify text
foreach(0..$#txt) {
print "got: $newtxt[$_], exp: $txt[$_]\nnot "
unless $newtxt[$_] eq $txt[$_];
&ok;
}
## test 14-15 verify parse
@newtxt = $module->parse(@txt);
foreach(0..$#txt) {
print 'got: ', $newtxt[$_], ', exp: "', $txt[$_], qq|"\nnot |
unless $newtxt[$_] eq '"'. $txt[$_] . '"';
&ok;
}