The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# 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.)

$| = 1;

END {print "1..0   # Skipping... tests for BDBaccess via network, unsupported on this host\n"
	unless $port;}

use Cwd;
use IO::Socket;
use IPTables::IPv4::DBTarpit::Tools;
use IO::Socket::INET;
use Mail::SpamCannibal::BDBclient qw(
	dataquery
	retrieve
	INADDR_NONE
);

### check if we can use network sockets

my $protoport = 10086;

foreach($protoport..$protoport+10) {
  my $s = IO::Socket::INET::->new(LocalPort	=> $_,
				  Type		=> SOCK_STREAM,
				  Listen	=> 1);
  if ($s) {
    close $s;
    $port = $_;
    last;
  }
}

if ($port) {
  print "1..34\n";
} else {
  exit 0;
}

print "ok 1\n";

######################### End of black magic.

$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 $cmd = "$localdir/bdbaccess -r $dbhome -f $db1 -d -p $port";
my $sock = 'localhost:'.$port;
my $timeout = 5;	# seconds;

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,
	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	dump dummy time data
print "failed to dump database\nnot "
        if $sw->dump($db1,\%dump);
&ok;

## test 11
verify_keys(\%addrs);

## test 12-18	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 19	ask for non-existent db
my ($key,$error) = dataquery(1,1,'bogus',$sock,$timeout);
print "returned unknown key\nnot "
	unless $key eq INADDR_NONE;
&ok;

print $@ if $@;

## test 20-26	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,$sock,$timeout);
  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 27-33	check values by key
foreach(sort keys %addrs) {
  my $netaddr = inet_aton($_);
  my ($IP,$val) = dataquery(0,$netaddr,$db1,$sock,$timeout);
  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 34	ask for non-existent record
($key,$error) = dataquery(0,inet_aton('127.1.2.3'),$db1,$sock,$timeout);
print "returned unknown key\nnot "
	unless $key eq INADDR_NONE;
&ok;

kill 9,$pid;
close Daemon;