# 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..11\n"; }
END {print "not ok 1\n" unless $loaded;}
#use diagnostics;
use Cwd;
use CTest;
use Socket;
$TCTEST = 'Mail::SpamCannibal::DNSBLserver::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;
}
my $localdir = cwd() .'/tmp';
mkdir $localdir,0755;
my $localstdout = $localdir .'/main.out';
# check contents of print buffer variables
sub checkSTDOUT {
my ($x) = @_;
open(MO,$localstdout) or die "can't open $localstdout\n";
local $/ = undef;
my $got = <MO>; # slurp file
close MO;
if($x) {
$x =~ s/\$/\\\$/g; # eliminate embedded '$' problem
print "UNMATCHED RETURN TEXT\n",$got,"\nnot "
unless $got =~ /^$x/;
} else {
print "UNEXPECTED RETURN TEXT\n",$got,"\nnot "
if $got;
}
&ok;
}
# save STDOUT and STDERR file handles
local (*SAVEOUT,*SAVEERR);
open SAVEOUT, ">&STDOUT";
open SAVEERR, ">&STDERR";
sub restoreSTD {
eval {
close STDOUT;
close STDERR;
open STDOUT, ">&SAVEOUT";
open STDERR, ">&SAVEERR";
};
return $@;
}
sub redirectSTD {
eval {
open STDOUT, ">$localstdout" or die "can't redirect STDOUT\n";
open STDERR, ">&STDOUT" or die "can't redirect STDERR\n";
select STDERR; $| = 1;
select STDOUT; $| = 1; # autoflush
};
my $rv = $@;
restoreSTD() if $rv;
return $rv;
}
sub callSTDOUT {
my($cb,@args) = @_;
return $@ if redirectSTD();
eval { &{$cb}(@args) };
my $rv = $@;
restoreSTD();
return $rv;
}
## test 2
my $expect = q
|dbhome -r => |. $localdir .q|
tarpit -i => tarpit
contrib -j => blcontrib
evidence -k => evidence
block => 0 AXFR transfers blocked
eflag => no message
dflag => 1 no daemon
oflag => 1 log to stdout
loglvl => 0 log enabled > 0
port => 53 port number
Tflag => 1 test mode
promiscuous => 0 reporting enabled
zone => foo.bar.com
Zflag => 0 Zap zone file TXT records
contact => root.foo.bar.com
uflag => 43200 SOA update/refresh
yflag => 3600 SOA retry
xflag => 86400 SOA expires
tflag => 10800 SOA ttl/minimum
local records:
NS => xx.yy.com
11.22.33.44
NS => ns2.zz.net
65.43.21.9
|;
my @x = ('-o', '-T',
'-r', $localdir,
'-z', 'foo.bar.com',
'-n', 'xx.yy.com', '-a', '11.22.33.44',
'-n', 'ns2.zz.net', '-a', '65.43.21.9',
'-e', 'no message',
);
# Something in perl 5.8 does not allow the redirection of
# STDOUT in an eval to a C program. The workaround is
# simply to abort the call to 'main' just prior to issuing
# the print statements since this is all tested elsewhere
#
print "unexpected return value, $_\nnot "
if &{"${TCTEST}::t_set_stop"}(1);
&ok;
# See comment above
# print "$_\nnot "
# if $_ = callSTDOUT(\&{"${TCTEST}::t_main"},'CTest',@x);
# &ok;
&{"${TCTEST}::t_main"}('CTest',@x);
# See comments above
## test 3 check returned values
# checkSTDOUT($expect);
&ok; # dummy
## test 4 initialize internals to zero, check stack nibbles
&{"${TCTEST}::t_initlb"}();
print "unexpected initialization values\n$_\nnot "
unless ($_ = join("\n",&{"${TCTEST}::t_ret_a_nibls"}())) eq
"0.0.0.0\n0.0.0.0\n0.0.0.0\n0.0.0.0";
&ok;
## test 5 check response stack
print "unexpected initialization values\n$_\nnot "
unless ($_ = join("\n",&{"${TCTEST}::t_ret_resp"}())) eq
"0.0.0.0\n0.0.0.0\n0.0.0.0\n0.0.0.0";
&ok;
## test 6-9 check empty text buffers
foreach(1..4) {
print "unexpected initial text buffer value: $_\nnot "
if $_ = &{"${TCTEST}::t_mybuffer"}($_);
&ok;
}
my @list = qw(
1.24.85.142
2.26.116.4
2.26.116.5
3.26.116.6
3.26.116.7
3.26.116.8
4.26.174.1
4.26.175.1
4.27.176.2
4.27.177.2
4.27.178.2
40.41.1.9
40.41.2.9
40.41.3.9
40.41.4.9
5.28.179.3
5.29.179.3
6.30.180.4
6.31.180.4
6.32.180.4
6.33.180.4
7.3.2.1
7.3.2.2
7.3.2.3
7.3.2.4
7.3.2.5
7.3.2.6
7.3.2.7
7.3.2.8
7.3.2.9
7.3.2.10
7.3.2.11
7.3.2.12
);
my $resp = inet_aton('127.0.0.2');
&{"${TCTEST}::t_cmdline"}('z','test.domain.com');
#&{"${TCTEST}::t_cmdline"}('Z',1);
## test 10 load STDOUT with results
if ($_ = redirectSTD()) {
print "$_\nnot ";
} else {
foreach(@list) {
&{"${TCTEST}::t_iload"}(inet_aton($_),$resp,"test item $_");
&{"${TCTEST}::t_iprint"}(STDOUT);
}
&{"${TCTEST}::t_ishift"}();
&{"${TCTEST}::t_oflush"}(STDOUT);
print "$_\nnot "
if $_ = restoreSTD();
}
&ok;
## test 11 check STDOUT
$expect = q
|$ORIGIN test.domain.com.
142.85.24.1 A 127.0.0.2
TXT "test item 1.24.85.142"
$ORIGIN 116.26.2.test.domain.com.
4 A 127.0.0.2
TXT "test item 2.26.116.4"
5 A 127.0.0.2
TXT "test item 2.26.116.5"
$ORIGIN test.domain.com.
$ORIGIN 116.26.3.test.domain.com.
6 A 127.0.0.2
TXT "test item 3.26.116.6"
7 A 127.0.0.2
TXT "test item 3.26.116.7"
8 A 127.0.0.2
TXT "test item 3.26.116.8"
$ORIGIN test.domain.com.
$ORIGIN 26.4.test.domain.com.
1.174 A 127.0.0.2
TXT "test item 4.26.174.1"
1.175 A 127.0.0.2
TXT "test item 4.26.175.1"
$ORIGIN 4.test.domain.com.
$ORIGIN 27.4.test.domain.com.
2.176 A 127.0.0.2
TXT "test item 4.27.176.2"
2.177 A 127.0.0.2
TXT "test item 4.27.177.2"
2.178 A 127.0.0.2
TXT "test item 4.27.178.2"
$ORIGIN test.domain.com.
$ORIGIN 41.40.test.domain.com.
9.1 A 127.0.0.2
TXT "test item 40.41.1.9"
9.2 A 127.0.0.2
TXT "test item 40.41.2.9"
9.3 A 127.0.0.2
TXT "test item 40.41.3.9"
9.4 A 127.0.0.2
TXT "test item 40.41.4.9"
$ORIGIN test.domain.com.
$ORIGIN 5.test.domain.com.
3.179.28 A 127.0.0.2
TXT "test item 5.28.179.3"
3.179.29 A 127.0.0.2
TXT "test item 5.29.179.3"
$ORIGIN test.domain.com.
$ORIGIN 6.test.domain.com.
4.180.30 A 127.0.0.2
TXT "test item 6.30.180.4"
4.180.31 A 127.0.0.2
TXT "test item 6.31.180.4"
4.180.32 A 127.0.0.2
TXT "test item 6.32.180.4"
4.180.33 A 127.0.0.2
TXT "test item 6.33.180.4"
$ORIGIN test.domain.com.
$ORIGIN 2.3.7.test.domain.com.
1 A 127.0.0.2
TXT "test item 7.3.2.1"
2 A 127.0.0.2
TXT "test item 7.3.2.2"
3 A 127.0.0.2
TXT "test item 7.3.2.3"
4 A 127.0.0.2
TXT "test item 7.3.2.4"
5 A 127.0.0.2
TXT "test item 7.3.2.5"
6 A 127.0.0.2
TXT "test item 7.3.2.6"
7 A 127.0.0.2
TXT "test item 7.3.2.7"
8 A 127.0.0.2
TXT "test item 7.3.2.8"
9 A 127.0.0.2
TXT "test item 7.3.2.9"
10 A 127.0.0.2
TXT "test item 7.3.2.10"
11 A 127.0.0.2
TXT "test item 7.3.2.11"
12 A 127.0.0.2
TXT "test item 7.3.2.12"
|;
checkSTDOUT($expect);