# 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..25\n"; }
END {print "not ok 1\n" unless $loaded;}
#use diagnostics;
use Net::DNS::ToolKit qw(
newhead
put_qdcount
put_ancount
get1char
inet_aton
);
use Net::DNS::ToolKit::RR;
use Net::DNS::ToolKit::Debug qw(
print_head
print_buf
);
use Net::DNS::Codes qw(:all);
use Net::Bind::rbldnsdAccessor qw(
:isc_constants
rblf_create_zone
rblf_query
rblf_next_answer
cons_str
rblf_dump_packet
);
$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;
}
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);
foreach(0..length($$bp) -1) {
$char = get1char($bp,$_);
next if $char == $expect[$_];
print "buffer mismatch $_, got: $char, exp: $expect[$_]\nnot ";
last;
}
&ok;
}
my $success = &ISC_R_SUCCESS;
my $notfound = &ISC_R_NOTFOUND;
my $zone1 = 'datasets/bl.my.zone.one.combined';
my $zone2 = 'datasets/bl.my.zone2.com.ip4set';
my $zone3 = 'datasets/bl.my.zone3.org.ip4tset';
# input: file above
# return zone,type,file
sub ztype {
(my $zfile = shift) =~ m|[^/]+/(.+)\.(\w+)$|;
return ($1,$2,$zfile);
}
## test 2 create zone3
my($zone,$ztype,$file) = ztype($zone3);
my $rv = rblf_create_zone($zone,$ztype,$file);
print 'got: '. cons_str($rv) .", exp: success\nnot "
unless $rv == $success;
&ok;
## test 3 check zone root
my $answers;
# check number of answers
($answers,$rv) = rblf_query($zone);
print 'got: '. cons_str($rv) .", exp: success\nnot "
unless $rv == $success;
&ok;
## test 4 check number of answers
print "got: $answers, exp: 4\nnot "
unless $answers == 4;
&ok;
## test 5 check packet info
my $exptext = q(
0 : 0000_0000 0x00 0
1 : 0000_0000 0x00 0
2 : 0000_0000 0x00 0
3 : 0000_0000 0x00 0
4 : 0000_0000 0x00 0
5 : 0000_0000 0x00 0
6 : 0000_0000 0x00 0
7 : 0000_0100 0x04 4
8 : 0000_0000 0x00 0
9 : 0000_0000 0x00 0
10 : 0000_0000 0x00 0
11 : 0000_0000 0x00 0
12 : 0000_0010 0x02 2
13 : 0110_0010 0x62 98 b
14 : 0110_1100 0x6C 108 l
15 : 0000_0010 0x02 2
16 : 0110_1101 0x6D 109 m
17 : 0111_1001 0x79 121 y
18 : 0000_0101 0x05 5
19 : 0111_1010 0x7A 122 z
20 : 0110_1111 0x6F 111 o
21 : 0110_1110 0x6E 110 n
22 : 0110_0101 0x65 101 e
23 : 0011_0011 0x33 51 3
24 : 0000_0011 0x03 3
25 : 0110_1111 0x6F 111 o
26 : 0111_0010 0x72 114 r
27 : 0110_0111 0x67 103 g
28 : 0000_0000 0x00 0
29 : 0000_0000 0x00 0
30 : 0000_0000 0x00 0
31 : 0000_0000 0x00 0
32 : 0000_0000 0x00 0
33 : 1100_0000 0xC0 192
34 : 0000_1100 0x0C 12
35 : 0000_0000 0x00 0
36 : 0000_0110 0x06 6
37 : 0000_0000 0x00 0
38 : 0000_0001 0x01 1
39 : 0000_0000 0x00 0
40 : 0000_0000 0x00 0
41 : 0000_0010 0x02 2
42 : 0101_1000 0x58 88 X
43 : 0000_0000 0x00 0
44 : 0001_1111 0x1F 31
45 : 1100_0000 0xC0 192
46 : 0000_1100 0x0C 12
47 : 0000_0110 0x06 6
48 : 0111_0011 0x73 115 s
49 : 0111_1001 0x79 121 y
50 : 0111_0011 0x73 115 s
51 : 0110_0001 0x61 97 a
52 : 0110_0100 0x64 100 d
53 : 0110_1101 0x6D 109 m
54 : 1100_0000 0xC0 192
55 : 0000_1111 0x0F 15
56 : 0100_0101 0x45 69 E
57 : 0011_0010 0x32 50 2
58 : 1000_0101 0x85 133
59 : 0011_0010 0x32 50 2
60 : 0000_0000 0x00 0
61 : 0000_0000 0x00 0
62 : 1010_1000 0xA8 168
63 : 1100_0000 0xC0 192
64 : 0000_0000 0x00 0
65 : 0000_0000 0x00 0
66 : 0000_0011 0x03 3
67 : 1000_0100 0x84 132
68 : 0000_0000 0x00 0
69 : 0000_0010 0x02 2
70 : 1010_0011 0xA3 163
71 : 0000_0000 0x00 0
72 : 0000_0000 0x00 0
73 : 0000_0000 0x00 0
74 : 1010_1000 0xA8 168
75 : 1100_0000 0xC0 192
76 : 1100_0000 0xC0 192
77 : 0000_1100 0x0C 12
78 : 0000_0000 0x00 0
79 : 0000_0010 0x02 2
80 : 0000_0000 0x00 0
81 : 0000_0001 0x01 1
82 : 0000_0000 0x00 0
83 : 0000_0000 0x00 0
84 : 1010_1000 0xA8 168
85 : 1100_0000 0xC0 192
86 : 0000_0000 0x00 0
87 : 0000_0010 0x02 2
88 : 1100_0000 0xC0 192
89 : 0000_1100 0x0C 12
90 : 1100_0000 0xC0 192
91 : 0000_1100 0x0C 12
92 : 0000_0000 0x00 0
93 : 0000_0010 0x02 2
94 : 0000_0000 0x00 0
95 : 0000_0001 0x01 1
96 : 0000_0000 0x00 0
97 : 0000_0000 0x00 0
98 : 1010_1000 0xA8 168
99 : 1100_0000 0xC0 192
100 : 0000_0000 0x00 0
101 : 0001_0101 0x15 21
102 : 0000_0011 0x03 3
103 : 0110_1110 0x6E 110 n
104 : 0111_0011 0x73 115 s
105 : 0011_0001 0x31 49 1
106 : 0000_1010 0x0A 10
107 : 0110_1110 0x6E 110 n
108 : 0110_0001 0x61 97 a
109 : 0110_1101 0x6D 109 m
110 : 0110_0101 0x65 101 e
111 : 0111_0011 0x73 115 s
112 : 0110_0101 0x65 101 e
113 : 0111_0010 0x72 114 r
114 : 0111_0110 0x76 118 v
115 : 0110_0101 0x65 101 e
116 : 0111_0010 0x72 114 r
117 : 0000_0100 0x04 4
118 : 0110_1001 0x69 105 i
119 : 0110_1110 0x6E 110 n
120 : 0110_0110 0x66 102 f
121 : 0110_1111 0x6F 111 o
122 : 0000_0000 0x00 0
123 : 1100_0000 0xC0 192
124 : 0000_1100 0x0C 12
125 : 0000_0000 0x00 0
126 : 0000_0010 0x02 2
127 : 0000_0000 0x00 0
128 : 0000_0001 0x01 1
129 : 0000_0000 0x00 0
130 : 0000_0000 0x00 0
131 : 1010_1000 0xA8 168
132 : 1100_0000 0xC0 192
133 : 0000_0000 0x00 0
134 : 0000_0110 0x06 6
135 : 0000_0011 0x03 3
136 : 0110_1110 0x6E 110 n
137 : 0111_0011 0x73 115 s
138 : 0011_0100 0x34 52 4
139 : 1100_0000 0xC0 192
140 : 0110_1010 0x6A 106 j
);
my($len,$packet,$pbuf,$pcur,$psans,$pend,$coff,$aoff) = rblf_dump_packet();
#print "pbuf = $pbuf\npcur = $pcur\npsans = $psans\npend = $pend\ncoff = $coff\naoff = $aoff\nlen = $len\n";
#print_buf(\$packet);
chk_exp(\$packet,\$exptext);
## test 6 verify answers
my ($get,$put,$parse) = new Net::DNS::ToolKit::RR;
my @answers = (
T_SOA, 600, 58, q(
0 : 0000_0010 0x02 2
1 : 0110_0010 0x62 98 b
2 : 0110_1100 0x6C 108 l
3 : 0000_0010 0x02 2
4 : 0110_1101 0x6D 109 m
5 : 0111_1001 0x79 121 y
6 : 0000_0101 0x05 5
7 : 0111_1010 0x7A 122 z
8 : 0110_1111 0x6F 111 o
9 : 0110_1110 0x6E 110 n
10 : 0110_0101 0x65 101 e
11 : 0011_0011 0x33 51 3
12 : 0000_0011 0x03 3
13 : 0110_1111 0x6F 111 o
14 : 0111_0010 0x72 114 r
15 : 0110_0111 0x67 103 g
16 : 0000_0000 0x00 0
17 : 0000_0110 0x06 6
18 : 0111_0011 0x73 115 s
19 : 0111_1001 0x79 121 y
20 : 0111_0011 0x73 115 s
21 : 0110_0001 0x61 97 a
22 : 0110_0100 0x64 100 d
23 : 0110_1101 0x6D 109 m
24 : 0000_0010 0x02 2
25 : 0110_1101 0x6D 109 m
26 : 0111_1001 0x79 121 y
27 : 0000_0101 0x05 5
28 : 0111_1010 0x7A 122 z
29 : 0110_1111 0x6F 111 o
30 : 0110_1110 0x6E 110 n
31 : 0110_0101 0x65 101 e
32 : 0011_0011 0x33 51 3
33 : 0000_0011 0x03 3
34 : 0110_1111 0x6F 111 o
35 : 0111_0010 0x72 114 r
36 : 0110_0111 0x67 103 g
37 : 0000_0000 0x00 0
38 : 0100_0101 0x45 69 E
39 : 0011_0010 0x32 50 2
40 : 1000_0101 0x85 133
41 : 0011_0010 0x32 50 2
42 : 0000_0000 0x00 0
43 : 0000_0000 0x00 0
44 : 1010_1000 0xA8 168
45 : 1100_0000 0xC0 192
46 : 0000_0000 0x00 0
47 : 0000_0000 0x00 0
48 : 0000_0011 0x03 3
49 : 1000_0100 0x84 132
50 : 0000_0000 0x00 0
51 : 0000_0010 0x02 2
52 : 1010_0011 0xA3 163
53 : 0000_0000 0x00 0
54 : 0000_0000 0x00 0
55 : 0000_0000 0x00 0
56 : 1010_1000 0xA8 168
57 : 1100_0000 0xC0 192
),
T_NS, 43200, 17, q(
0 : 0000_0010 0x02 2
1 : 0110_0010 0x62 98 b
2 : 0110_1100 0x6C 108 l
3 : 0000_0010 0x02 2
4 : 0110_1101 0x6D 109 m
5 : 0111_1001 0x79 121 y
6 : 0000_0101 0x05 5
7 : 0111_1010 0x7A 122 z
8 : 0110_1111 0x6F 111 o
9 : 0110_1110 0x6E 110 n
10 : 0110_0101 0x65 101 e
11 : 0011_0011 0x33 51 3
12 : 0000_0011 0x03 3
13 : 0110_1111 0x6F 111 o
14 : 0111_0010 0x72 114 r
15 : 0110_0111 0x67 103 g
16 : 0000_0000 0x00 0
),
T_NS, 43200, 21, q(
0 : 0000_0011 0x03 3
1 : 0110_1110 0x6E 110 n
2 : 0111_0011 0x73 115 s
3 : 0011_0001 0x31 49 1
4 : 0000_1010 0x0A 10
5 : 0110_1110 0x6E 110 n
6 : 0110_0001 0x61 97 a
7 : 0110_1101 0x6D 109 m
8 : 0110_0101 0x65 101 e
9 : 0111_0011 0x73 115 s
10 : 0110_0101 0x65 101 e
11 : 0111_0010 0x72 114 r
12 : 0111_0110 0x76 118 v
13 : 0110_0101 0x65 101 e
14 : 0111_0010 0x72 114 r
15 : 0000_0100 0x04 4
16 : 0110_1001 0x69 105 i
17 : 0110_1110 0x6E 110 n
18 : 0110_0110 0x66 102 f
19 : 0110_1111 0x6F 111 o
20 : 0000_0000 0x00 0
),
T_NS, 43200, 21, q(
0 : 0000_0011 0x03 3
1 : 0110_1110 0x6E 110 n
2 : 0111_0011 0x73 115 s
3 : 0011_0100 0x34 52 4
4 : 0000_1010 0x0A 10
5 : 0110_1110 0x6E 110 n
6 : 0110_0001 0x61 97 a
7 : 0110_1101 0x6D 109 m
8 : 0110_0101 0x65 101 e
9 : 0111_0011 0x73 115 s
10 : 0110_0101 0x65 101 e
11 : 0111_0010 0x72 114 r
12 : 0111_0110 0x76 118 v
13 : 0110_0101 0x65 101 e
14 : 0111_0010 0x72 114 r
15 : 0000_0100 0x04 4
16 : 0110_1001 0x69 105 i
17 : 0110_1110 0x6E 110 n
18 : 0110_0110 0x66 102 f
19 : 0110_1111 0x6F 111 o
20 : 0000_0000 0x00 0
),
);
my $off = $aoff;
for(my $i = 0;$i < $answers *4; $i += 4) {
my($type,$ttl,$rdl,$rdata) = rblf_next_answer();
print "TYPE got: ". $TypeTxt->{$type} .", exp: ". TypeTxt->{$answers[$i]} ."\nnot "
unless $type == $answers[$i];
&ok;
print "TTL got: $ttl, exp: $answers[$i +1]\nnot "
unless $ttl == $answers[$i +1];
&ok;
print "RDL got: $rdl, exp: $answers[$i +2]\nnot "
unless $rdl == $answers[$i +2];
&ok;
# print_buf(\$rdata);
chk_exp(\$rdata,\$answers[$i+3]);
}
## test 22 query for good RBL entry 212.142.152.10
# check number of answers
my $lookup = '10.152.142.212.';
($answers,$rv) = rblf_query($lookup . $zone);
print 'got: '. cons_str($rv) .", exp: success\nnot "
unless $rv == $success;
&ok;
## test 23 check number of answers
print "got: $answers, exp: 6\nnot "
unless $answers == 2;
&ok;
## test 24 check packet info
$exptext = q(
0 : 0000_0000 0x00 0
1 : 0000_0000 0x00 0
2 : 0000_0000 0x00 0
3 : 0000_0000 0x00 0
4 : 0000_0000 0x00 0
5 : 0000_0000 0x00 0
6 : 0000_0000 0x00 0
7 : 0000_0010 0x02 2
8 : 0000_0000 0x00 0
9 : 0000_0000 0x00 0
10 : 0000_0000 0x00 0
11 : 0000_0000 0x00 0
12 : 0000_0010 0x02 2
13 : 0011_0001 0x31 49 1
14 : 0011_0000 0x30 48 0
15 : 0000_0011 0x03 3
16 : 0011_0001 0x31 49 1
17 : 0011_0101 0x35 53 5
18 : 0011_0010 0x32 50 2
19 : 0000_0011 0x03 3
20 : 0011_0001 0x31 49 1
21 : 0011_0100 0x34 52 4
22 : 0011_0010 0x32 50 2
23 : 0000_0011 0x03 3
24 : 0011_0010 0x32 50 2
25 : 0011_0001 0x31 49 1
26 : 0011_0010 0x32 50 2
27 : 0000_0010 0x02 2
28 : 0110_0010 0x62 98 b
29 : 0110_1100 0x6C 108 l
30 : 0000_0010 0x02 2
31 : 0110_1101 0x6D 109 m
32 : 0111_1001 0x79 121 y
33 : 0000_0101 0x05 5
34 : 0111_1010 0x7A 122 z
35 : 0110_1111 0x6F 111 o
36 : 0110_1110 0x6E 110 n
37 : 0110_0101 0x65 101 e
38 : 0011_0011 0x33 51 3
39 : 0000_0011 0x03 3
40 : 0110_1111 0x6F 111 o
41 : 0111_0010 0x72 114 r
42 : 0110_0111 0x67 103 g
43 : 0000_0000 0x00 0
44 : 0000_0000 0x00 0
45 : 0000_0000 0x00 0
46 : 0000_0000 0x00 0
47 : 0000_0000 0x00 0
48 : 1100_0000 0xC0 192
49 : 0000_1100 0x0C 12
50 : 0000_0000 0x00 0
51 : 0000_0001 0x01 1
52 : 0000_0000 0x00 0
53 : 0000_0001 0x01 1
54 : 0000_0000 0x00 0
55 : 0000_0000 0x00 0
56 : 1010_1000 0xA8 168
57 : 1100_0000 0xC0 192
58 : 0000_0000 0x00 0
59 : 0000_0100 0x04 4
60 : 0111_1111 0x7F 127
61 : 0000_0000 0x00 0
62 : 0000_0000 0x00 0
63 : 0000_0010 0x02 2
64 : 1100_0000 0xC0 192
65 : 0000_1100 0x0C 12
66 : 0000_0000 0x00 0
67 : 0001_0000 0x10 16
68 : 0000_0000 0x00 0
69 : 0000_0001 0x01 1
70 : 0000_0000 0x00 0
71 : 0000_0000 0x00 0
72 : 1010_1000 0xA8 168
73 : 1100_0000 0xC0 192
74 : 0000_0000 0x00 0
75 : 0101_0101 0x55 85 U
76 : 0101_0100 0x54 84 T
77 : 0110_0010 0x62 98 b
78 : 0110_1100 0x6C 108 l
79 : 0110_1111 0x6F 111 o
80 : 0110_0011 0x63 99 c
81 : 0110_1011 0x6B 107 k
82 : 0110_0101 0x65 101 e
83 : 0110_0100 0x64 100 d
84 : 0010_1100 0x2C 44 ,
85 : 0010_0000 0x20 32
86 : 0101_0011 0x53 83 S
87 : 0110_0101 0x65 101 e
88 : 0110_0101 0x65 101 e
89 : 0011_1010 0x3A 58 :
90 : 0010_0000 0x20 32
91 : 0110_1000 0x68 104 h
92 : 0111_0100 0x74 116 t
93 : 0111_0100 0x74 116 t
94 : 0111_0000 0x70 112 p
95 : 0011_1010 0x3A 58 :
96 : 0010_1111 0x2F 47 /
97 : 0010_1111 0x2F 47 /
98 : 0111_0111 0x77 119 w
99 : 0111_0111 0x77 119 w
100 : 0111_0111 0x77 119 w
101 : 0010_1110 0x2E 46 .
102 : 0110_1101 0x6D 109 m
103 : 0111_1001 0x79 121 y
104 : 0010_1110 0x2E 46 .
105 : 0111_1010 0x7A 122 z
106 : 0110_1111 0x6F 111 o
107 : 0110_1110 0x6E 110 n
108 : 0110_0101 0x65 101 e
109 : 0011_0011 0x33 51 3
110 : 0010_1110 0x2E 46 .
111 : 0110_1111 0x6F 111 o
112 : 0111_0010 0x72 114 r
113 : 0110_0111 0x67 103 g
114 : 0010_1111 0x2F 47 /
115 : 0110_0011 0x63 99 c
116 : 0110_0001 0x61 97 a
117 : 0110_1110 0x6E 110 n
118 : 0110_1110 0x6E 110 n
119 : 0110_1001 0x69 105 i
120 : 0110_0010 0x62 98 b
121 : 0110_0001 0x61 97 a
122 : 0110_1100 0x6C 108 l
123 : 0010_1110 0x2E 46 .
124 : 0110_0011 0x63 99 c
125 : 0110_0111 0x67 103 g
126 : 0110_1001 0x69 105 i
127 : 0011_1111 0x3F 63 ?
128 : 0111_0000 0x70 112 p
129 : 0110_0001 0x61 97 a
130 : 0110_0111 0x67 103 g
131 : 0110_0101 0x65 101 e
132 : 0011_1101 0x3D 61 =
133 : 0110_1100 0x6C 108 l
134 : 0110_1111 0x6F 111 o
135 : 0110_1111 0x6F 111 o
136 : 0110_1011 0x6B 107 k
137 : 0111_0101 0x75 117 u
138 : 0111_0000 0x70 112 p
139 : 0010_0110 0x26 38 &
140 : 0110_1100 0x6C 108 l
141 : 0110_1111 0x6F 111 o
142 : 0110_1111 0x6F 111 o
143 : 0110_1011 0x6B 107 k
144 : 0111_0101 0x75 117 u
145 : 0111_0000 0x70 112 p
146 : 0011_1101 0x3D 61 =
147 : 0011_0010 0x32 50 2
148 : 0011_0001 0x31 49 1
149 : 0011_0010 0x32 50 2
150 : 0010_1110 0x2E 46 .
151 : 0011_0001 0x31 49 1
152 : 0011_0100 0x34 52 4
153 : 0011_0010 0x32 50 2
154 : 0010_1110 0x2E 46 .
155 : 0011_0001 0x31 49 1
156 : 0011_0101 0x35 53 5
157 : 0011_0010 0x32 50 2
158 : 0010_1110 0x2E 46 .
159 : 0011_0001 0x31 49 1
160 : 0011_0000 0x30 48 0
);
($len,$packet,$pbuf,$pcur,$psans,$pend,$coff,$aoff) = rblf_dump_packet();
#print "pbuf = $pbuf\npcur = $pcur\npsans = $psans\npend = $pend\ncoff = $coff\naoff = $aoff\nlen = $len\n";
#print_buf(\$packet);
chk_exp(\$packet,\$exptext);
## test 25 query for bad RBL entry
# check number of answers
$lookup = '1.2.3.4.';
($answers,$rv) = rblf_query($lookup . $zone);
print 'got: '. cons_str($rv) .", exp: not found\nnot "
unless $rv == $notfound;
&ok;