# 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..83\n"; }
END {print "not ok 1\n" unless $loaded;}
use Cwd;
use CTest;
use IPTables::IPv4::DBTarpit::Tools;
use Mail::SpamCannibal::BDBclient qw(
dataquery
retrieve
inet_aton
inet_ntoa
INADDR_NONE
);
$TCTEST = 'Mail::SpamCannibal::BDBaccess::CTest';
$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;
umask 007;
foreach my $dir (qw(tmp tmp.dbhome tmp.bogus)) {
if (-d $dir) { # clean up previous test runs
opendir(T,$dir);
@_ = grep(!/^\./, readdir(T));
closedir T;
foreach(@_) {
unlink "$dir/$_";
}
rmdir $dir or die "COULD NOT REMOVE $dir DIRECTORY\n";
}
unlink $dir if -e $dir; # remove files of this name as well
}
sub ok {
print "ok $test\n";
++$test;
}
sub next_sec {
my ($then) = @_;
$then = time unless $then;
my $now;
# wait for epoch
do { select(undef,undef,undef,0.1); $now = time }
while ( $then >= $now );
$now;
}
my %dump; # defined here for binding with verify subroutines
sub verify_keys {
my($ap) = @_;
my $x = keys %$ap;
my $y = keys %dump;
print "bad key count, in=$x, out=$y\nnot "
unless $x == $y;
&ok;
#print "verified key count\n";
}
sub verify_data {
my($Force,$ap) = @_;
while(my($key,$val) = each %dump) {
$key = inet_ntoa($key) unless length($key) > 4;
print $key, " => $val\nnot "
unless ! $Force &&
exists $ap->{$key} && $ap->{$key} eq $val;
&ok;
}
}
my $localdir = cwd();
my $dbhome = "$localdir/tmp.dbhome";
my $db1 = 'tarpit';
my $db2 = 'rbltxt';
my $unsocket = $dbhome .'/bdbread';
my $cmd = "$localdir/bdbaccess -r $dbhome -f $db1 -f $db2 -d";
my %text = ( # must not be == 4 characters. Real data is not.
'0.0.0.1' => 'oohoohoohone',
'1.0.0.0', => '1oooh',
'1.2.3.4', => 'one.two.three.four',
'4.3.2.1', => 'four.three.two.one',
'12.34.56.78', => '12dot34.56.78',
'101.202.33.44', => '101dot202dot33dot44',
'254.253.252.251', => "250's",
);
my %addrs = (
'0.0.0.1' => 1111,
'1.0.0.0', => 1000,
'1.2.3.4', => 1234,
'4.3.2.1', => 4321,
'12.34.56.78', => 12345678,
'101.202.33.44', => 1120230344,
'254.253.252.251', => 254321,
);
my $sw = new IPTables::IPv4::DBTarpit::Tools(
dbfile => $db1,
txtfile => $db2,
dbhome => $dbhome,
);
###########################################################
#### database's created, data loaded, connect C daemon ####
###########################################################
## test 2 open daemon
my $pid;
print "could open not daemon\nnot "
unless ($pid = open(Daemon,"| $cmd"));
&ok;
## test 3-9 insert dummy time tags
foreach(sort keys %addrs) {
print "failed to insert $db1 record $_\nnot "
if $sw->put($db1,inet_aton($_),$addrs{$_});
&ok;
}
## test 10-16 insert dummy text strings
foreach(sort keys %text) {
print "failed to insert $db2 record $_\nnot "
if $sw->put($db2,inet_aton($_),$text{$_});
&ok;
}
## test 17 dump text data
print "failed to dump database\nnot "
if $sw->dump($db2,\%dump);
&ok;
## test 18
verify_keys(\%text);
## test 19-25 verify data
verify_data(0,\%text); # argument 0 or 1 to force printing
## test 26 dump dummy time data
print "failed to dump database\nnot "
if $sw->dump($db1,\%dump);
&ok;
## test 27
verify_keys(\%addrs);
## test 28-34 verify data
verify_data(0,\%addrs); # argument 0 or 1 to force printing
$sw->closedb();
&next_sec(time +2); # wait a bit to let daemon come to life
## test 35 ask for non-existent db
my ($key,$error) = dataquery(1,1,'bogus',$unsocket);
print "returned unknown key\nnot "
unless $key eq INADDR_NONE;
&ok;
## test 36 check returned error code
$_ = &{"${TCTEST}::t_bdberror"}($error);
print "unexpected error return '$_'\nnot "
unless $_ =~ /notfound/i;
&ok;
## test 37-43 check values by cursor
# tests = 7 keys
my @keys = sort keys %addrs;
foreach(1..scalar @keys) {
my $cursor = $_;
my ($IP,$val) = dataquery(1,$cursor,$db1,$unsocket);
if ($@) {
print "failed to get data: $@\nnot ";
} else {
if ($IP) {
my $key = inet_ntoa($IP);
if (exists $addrs{$key}) {
print "VAL: got: $val, exp: $addrs{$key}\nnot "
unless $val == $addrs{$key};
} else {
print "KEY not found: $key\nnot ";
}
} else {
print "DB error: $val\nnot "
}
}
&ok;
}
## test 44-50 check values by key
foreach(sort keys %addrs) {
my $netaddr = inet_aton($_);
my ($IP,$val) = dataquery(0,$netaddr,$db1,$unsocket);
if ($@) {
print "failed to get data: $@\nnot ";
} else {
if ($IP) {
my $key = inet_ntoa($IP);
if (exists $addrs{$key}) {
print "VAL: got: $val, exp: $addrs{$key}\nnot "
unless $val == $addrs{$key};
} else {
print "KEY not found: $key\nnot ";
}
} else {
print "DB error: $val\nnot "
}
}
&ok;
}
## test 51 ask for non-existent record
($key,$error) = dataquery(0,inet_aton('127.1.2.3'),$db1,$unsocket);
print "returned unknown key\nnot "
unless $key eq INADDR_NONE;
&ok;
## test 52 check returned error code
$_ = &{"${TCTEST}::t_bdberror"}($error);
print "unexpected error return '$_'\nnot "
unless $_ =~ /notfound/i;
&ok;
#########################
## check ascii records ##
#########################
## test 53-59 check values by cursor
my @orderedlist; # save records in order for later
@keys = sort keys %text;
foreach(1..scalar @keys) {
my $cursor = $_;
my ($IP,$val) = dataquery(1,$cursor,$db2,$unsocket);
if ($@) {
print "failed to get data: $@\nnot ";
} else {
if ($IP) {
my $key = inet_ntoa($IP);
push @orderedlist, $key;
if (exists $text{$key}) {
print "VAL: got: $val, exp: $text{$key}\nnot "
unless $val eq $text{$key};
} else {
print "KEY not found: $key\nnot ";
}
} else {
print "DB error: $val\nnot "
}
}
&ok;
}
## test 60-66 check values by key
foreach(sort keys %text) {
my $netaddr = inet_aton($_);
my ($IP,$val) = dataquery(0,$netaddr,$db2,$unsocket);
if ($@) {
print "failed to get data: $@\nnot ";
} else {
if ($IP) {
my $key = inet_ntoa($IP);
if (exists $text{$key}) {
print "VAL: got: $val, exp: $text{$key}\nnot "
unless $val eq $text{$key};
} else {
print "KEY not found: $key\nnot ";
}
} else {
print "DB error: $val\nnot "
}
}
&ok;
}
############ now check for return of number of keys and version number
## test 67 version string
my $version = &{"${TCTEST}::t_bdbversion"}();
$version = '0.'.$version;
my ($IP,$val) = dataquery(1,0,$db1,$unsocket); # query for record ZERO
if ($@) {
print "failed to get data: $@\nnot ";
} else {
if ($IP) {
if( my $dbversion = inet_ntoa($IP)) {
print "got version string '$dbversion', exp: $version\nnot "
unless $dbversion eq $version;
} else {
print "invalid version string\nnot ";
}
} else {
print "version string not returned\nnot ";
}
}
&ok;
## test 68 number of records
print "got: $val, exp: ", scalar keys %addrs, "\nnot "
unless $val = scalar keys %addrs;
&ok;
############# there are seven keys, retrieve the first 4
## test 69 retrieve some sequential records
my @list;
my $count;
my $want = 4;
my $start = 1;
print "retrieve failed, undefined\nnot "
unless ($count = retrieve($want,$start+1,$db2,\@list,$unsocket,0));
&ok;
## test 70 check count
print "count is: $count, exp: $want\nnot "
unless $count == $want;
&ok;
## test 71-74 check content
foreach(0..$#list) {
$list[$_] = inet_ntoa($list[$_]);
print "got: $list[$_], exp: $orderedlist[$_+$start]\nnot "
unless $list[$_] eq $orderedlist[$_+$start];
&ok;
}
## test 75 retrieve them all
$want = 10; # there are ONLY 7
$start = 0;
print "retrieve failed, undefined\nnot "
unless ($count = retrieve($want,$start+1,$db2,\@list,$unsocket,0));
&ok;
## test 76 check count
print "count is: $count, exp: ", scalar @orderedlist, "\nnot "
unless $count == @orderedlist;
&ok;
## test 77-83 check content
foreach(0..$#orderedlist) {
$list[$_] = inet_ntoa($list[$_]);
print "got: $list[$_], exp: $orderedlist[$_+$start]\nnot "
unless $list[$_] eq $orderedlist[$_+$start];
&ok;
}
kill 9,$pid;
close Daemon;