whoseip: improve error diagnostics and debugging

2 files changed, 46 insertions, 26 deletions

diff --git a/whoseip/Whoseip/DB.pm b/whoseip/Whoseip/DB.pm
index fbd3a61..696afd2 100644
--- a/whoseip/Whoseip/DB.pm
+++ b/whoseip/Whoseip/DB.pm
@@ -20,6 +20,7 @@ use strict;
 use Fcntl qw(SEEK_SET SEEK_CUR);
 use Socket qw(inet_ntoa);
 use Storable qw(freeze thaw);
+use Carp;
 
 require Exporter;
 our @ISA = qw(Exporter);
@@ -192,27 +193,29 @@ sub ipdb_open {
 	    $ipdbfile{mode} = "<";
 	}
 	open($fd, $ipdbfile{mode}, $filename)
-	    or die "can't open $filename: $!";
+	    or croak "can't open $filename: $!";
 	binmode $fd;
-	die "$filename is not a valid IP cache file"
+	croak "$filename is not a valid IP cache file"
 	    unless sysread($fd, my $s, 512) == 512;
 	my ($sign,$maj,$min,$size,$np,$count,@tab) =
 	    unpack('Z8 S S L L L L*', $s);
-	die "$filename is not a valid IP cache file"
+	croak "$filename is not a valid IP cache file"
 	    unless $sign eq $dbsign;
-	die "$filename is of wrong version ($maj.$min, expected $vmajor.$vminor)"
+	croak "$filename is of wrong version ($maj.$min, expected $vmajor.$vminor)"
 	    unless ($maj == $vmajor and $min == $vminor);
-	die "$filename: page size too small ($size)" if ($size < 1032);
+	croak "$filename: page size too small ($size)" if ($size < 1032);
 
 	$ipdbfile{pagesize} = $size;
 	$ipdbfile{numpages} = $np;
 	
 	for (my $i = 0; $i < $count; $i += 2) {
 	    $ipdbfile{rootidx}->{$tab[$i]} = $tab[$i+1];
+	    print STDERR "ROOTIDX $tab[$i]=$tab[$i+1]\n"
+		if $_{debug};
 	}
     } else {
 	open($fd, "+>", $filename)
-	    or die "can't open $filename: $!";
+	    or croak "can't open $filename: $!";
 	binmode $fd;
 	$ipdbfile{pagesize} = defined($_{pagesize}) ? $_{pagesize} : 1280;
 	$ipdbfile{numpages} = 0;
@@ -223,6 +226,7 @@ sub ipdb_open {
     $ipdbfile{fd} = $fd;
     $ipdbfile{maxpagecache} =
 	defined($_{maxpagecache}) ? $_{maxpagecache} : 16;
+    $ipdbfile{debug} = $_{debug};
     return \%ipdbfile;
 }
 
@@ -230,17 +234,22 @@ sub ipdb_save_page($$) {
     my ($dbf, $page) = @_;
 
     if (sysseek($dbf->{fd}, $page->{off}, SEEK_SET) != $page->{off}) {
-	die "$dbf->{filename}: can't seek: $!";
+	croak "$dbf->{filename}: can't seek: $!";
     }
 
     my $ret;
     if ($page->{type} == IPDB_PAGE_INDEX) {
+	print STDERR "saving index page $page->{off}: ".
+	    join(',', @{$page->{tab}})."\n"
+	    if $dbf->{debug};
 	$ret = syswrite($dbf->{fd}, pack('LL[257].',
 					 $page->{type},
 					 @{$page->{tab}},
 					 $dbf->{pagesize}),
 			$dbf->{pagesize});
     } elsif ($page->{type} == IPDB_PAGE_LEAF) {
+	print STDERR "saving leaf page $page->{off}\n"
+	    if $dbf->{debug};
 	my @a;
 	foreach my $ent (@{$page->{tab}}) {
 	    push @a, @{$ent}[0 .. 3],freeze($ent->[4]);
@@ -252,9 +261,9 @@ sub ipdb_save_page($$) {
 			     $page->{next},
 			     @a));
     } else {
-	die "BOO!";
+	croak "unrecognized page type ($page->{type})";
     }
-    die "$dbf->{file}: write error at $page->{off}: $ret: $!"
+    croak "$dbf->{file}: write error at $page->{off}: $ret: $!"
 	unless ($ret == $dbf->{pagesize});
 	
     delete $page->{dirty};
@@ -315,16 +324,16 @@ previous call to B<ipdb_open>.
 sub ipdb_close($) {
     my $dbf = shift;
     if ($dbf->{modified}) {
-	die "$dbf->{filename}: can't seek: $!"
+	croak "$dbf->{filename}: can't seek: $!"
 	    if (sysseek($dbf->{fd}, 0, SEEK_SET) != 0);
 	my $n = syswrite($dbf->{fd},
-			 pack('Z8 S S L L L (LL)* @512',
+			 pack('Z8 S S L L L L* @512',
 			      $dbsign, $vmajor, $vminor,
 			      $dbf->{pagesize}, $dbf->{numpages},
-			      keys(%{$dbf->{rootidx}}),
+			      keys(%{$dbf->{rootidx}})+0,
 			      map { $_, $dbf->{rootidx}{$_} }
 			        keys %{$dbf->{rootidx}}));
-	die "$dbf->{filename}: write error at header: $n: $!"
+	croak "$dbf->{filename}: write error at header: $n: $!"
 	    unless ($n == 512);
     }
     while (my ($off, $page) = each %{$dbf->{pagecache}}) {
@@ -338,32 +347,32 @@ sub ipdb_get_page($$) {
     my %ret;
     
     if (sysseek($dbf->{fd}, $off, SEEK_SET) != $off) {
-	die "$dbf->{filename}: can't seek: $!";
+	croak "$dbf->{filename}: can't seek: $!";
     }
 
     my $n = sysread($dbf->{fd}, my $s, $dbf->{pagesize});
     unless (defined($n)) {
-	die "$dbf->{filename}: can't read page: $!";
+	croak "$dbf->{filename}: can't read page: $!";
     } elsif ($n != $dbf->{pagesize}) {
-	die "$dbf->{filename}: short read ($n < $dbf->{pagesize})";
+	croak "$dbf->{filename}: short read ($n < $dbf->{pagesize})";
     }
 
     $ret{type} = unpack('L', $s);
     $ret{off} = $off;
     if ($ret{type} == IPDB_PAGE_INDEX) {
+	print STDERR "found index page at $off\n" if $dbf->{debug};
 	my ($x, @a) = unpack('LL257', $s);
 	$ret{tab} = \@a;
     } elsif ($ret{type} == IPDB_PAGE_LEAF) {
+	print STDERR "found leaf page at $off\n" if $dbf->{debug};
 	(my $x, my $nent, $ret{next}) =
 	    unpack('LLL', $s);
 	my ($x1, $x2, $x3, @a) = unpack("LLL(LLLa2L/a)$nent", $s);
 	for (my $i = 0; $i < $nent; $i += 5) {
 	    push @{$ret{tab}}, [ @a[$i .. $i+3], thaw $a[$i+4] ];
 	}
-#	print "$nent\n";
-#	print join(', ', @{$ret{tab}})."\n";
     } else {
-	die "$dbf->{filename}: invalid page type at offset $off";
+	croak "$dbf->{filename}: invalid page type at offset $off";
     }
 	
     return \%ret;    
@@ -393,9 +402,13 @@ sub ipdb_get_root_page($$) {
 
     if (!defined($dbf->{rootidx}{$nbits})) {
 	$p = ipdb_alloc_page($dbf, IPDB_PAGE_INDEX);
+	print STDERR "root page for $nbits: created at $p->{off}\n"
+	    if $dbf->{debug};
 	$dbf->{rootidx}{$nbits} = $p->{off};
 	$dbf->{modified}++;
     } else {
+	print STDERR "root page for $nbits: $dbf->{rootidx}{$nbits}\n"
+	    if $dbf->{debug};
 	$p = ipdb_cache_get($dbf, $dbf->{rootidx}{$nbits});
     }
     return $p;
@@ -439,20 +452,28 @@ sub ipdb_lookup($$) {
     my @ipo;
     my $ipn;
     my $nbits;
-    
+
     if ($ipstr =~ /^$ipv4rx$/) {
 	@ipo = split(/\./, $ipstr);
 	$ipn = ($ipo[0] << 24) + ($ipo[1] << 16) + ($ipo[2] << 8) + $ipo[3];
 	$nbits = 32;
     } else {
-	# FIXME: diagnostics
+	print STDERR "ipdb_lookup: unsupported IP address $ipstr\n"
+	    if $dbf->{debug};
 	return undef;
     }
 
+    print STDERR "ipdb_lookup: looking up for $ipstr\n"
+	if $dbf->{debug};
     my $page = ipdb_get_root_page($dbf, $nbits);
     my $n = 0;
     while (1) {
 	if ($page->{type} == IPDB_PAGE_INDEX) {
+	    print STDERR "index page $page->{off}: ".
+		join(',', @{$page->{tab}})."\n"
+		if $dbf->{debug};
+	    print STDERR "ipdb_lookup: octet ${n}=$ipo[$n], off=$page->{tab}[$ipo[$n]]\n"
+		if $dbf->{debug};
 	    if ($page->{tab}[$ipo[$n]]) {
 		$page = ipdb_cache_get($dbf, $page->{tab}[$ipo[$n]]);
 		++$n;
@@ -505,8 +526,7 @@ sub ipdb_insert {
 	$netmask = (0xffffffff ^ (0xffffffff >> $masklen));
 	$nbits = 32;
     } else {
-	# FIXME: error message
-	die "boo $cidr";
+	carp "invalid CIDR: $cidr";
 	return 0;
     }
 
@@ -526,7 +546,7 @@ sub ipdb_insert {
 
     if ($page->{tab}[256]) {
 	$page = ipdb_cache_get($dbf, $page->{tab}[256]);
-	die "$dbf->{filename}: index page found where leaf was expected"
+	croak "$dbf->{filename}: index page found where leaf was expected"
 	    unless $page->{type} == IPDB_PAGE_LEAF;
     } else {
 	my $p = ipdb_alloc_page($dbf, IPDB_PAGE_LEAF);
@@ -540,7 +560,7 @@ sub ipdb_insert {
     while ($#{$page->{tab}} == $maxent) {
 	if ($page->{next}) {
 	    $page = ipdb_cache_get($dbf, $page->{next});
-	    die "$dbf->{filename}: index page found where leaf was expected"
+	    croak "$dbf->{filename}: index page found where leaf was expected"
 		unless $page->{type} == IPDB_PAGE_LEAF;
 	} else {
 	    my $p = ipdb_alloc_page($dbf, IPDB_PAGE_LEAF);
diff --git a/whoseip/whoseip.pl b/whoseip/whoseip.pl
index d5f5f11..e267a4c 100644
--- a/whoseip/whoseip.pl
+++ b/whoseip/whoseip.pl
@@ -681,7 +681,7 @@ GetOptions("h" => sub {
 
 if (defined($dbfile)) {
     $dbfile .= "whoseip.db" if (-d $dbfile);
-    $dbf = ipdb_open($dbfile);
+    $dbf = ipdb_open($dbfile, debug => $debug);
 }
 
 if (defined($fastcgi)) {