whoseip: recover gracefully after cache failures

* whoseip/Makefile.PL (WriteMakefile): Use VERSION_FROM.
* whoseip/Whoseip/DB.pm (ipdb_lookup_unlocked): Add more data to the
output.
* whoseip/whoseip.pl: Protect ipdb_ calls by eval.
(output): Rename to expandout.
(format_out): Rename to print_result.
Document return codes.

3 files changed, 88 insertions, 20 deletions

diff --git a/whoseip/Makefile.PL b/whoseip/Makefile.PL
index 9fb3d76..0557ffe 100644
--- a/whoseip/Makefile.PL
+++ b/whoseip/Makefile.PL
@@ -23,7 +23,7 @@ use ExtUtils::AutoInstall (
 	 'Pod::Man' => 2.25,
 	 'Net::CIDR' => 0.14,
 	 'Data::UUID' => 1.219,
-	 'Data::Dumper' => 2.135_06,
+	 'Data::Dumper' => 2.135,
 	 'Storable' => 2.34
     ]
 );
@@ -33,7 +33,7 @@ WriteMakefile(
     'AUTHOR'            => 'Sergey Poznyakoff <gray@gnu.org>',
     'ABSTRACT'          => 'Identifies IP addresses',
     'FIRST_MAKEFILE'    => 'Makefile',
-    'VERSION'           => '1.00',
+    'VERSION_FROM'      => 'Whoseip/DB.pm',
     'EXE_FILES'         => [ 'whoseip' ],
     'PM'                => { 'Whoseip/DB.pm' => '$(INST_LIBDIR)/Whoseip/DB.pm' }
 );
diff --git a/whoseip/Whoseip/DB.pm b/whoseip/Whoseip/DB.pm
index 5cc36c9..a824491 100644
--- a/whoseip/Whoseip/DB.pm
+++ b/whoseip/Whoseip/DB.pm
@@ -37,7 +37,7 @@ our @EXPORT_OK = ( qw(ipdb_open ipdb_lookup ipdb_insert
 
 our @EXPORT = qw();
 
-our $VERSION = "0.1";
+our $VERSION = "1.0";
 
 my %ipv4_mask2len;
 my @ipv4_len2mask;
@@ -772,7 +772,10 @@ sub ipdb_lookup_unlocked($$) {
 		}
 		my %res = ( country => $r->[3],
 			    network => inet_ntoa(pack('N', $r->[0])),
-			    netmask => inet_ntoa(pack('N', $r->[1])) );
+			    netmask => inet_ntoa(pack('N', $r->[1])),
+		            timestamp => $r->[2],
+		            ttl => time - $r->[2],
+		            version => $VERSION );
 		@res{keys %{$r->[4]}} = values %{$r->[4]}
 		    if (defined($r->[4]) and ref($r->[4]) eq 'HASH');
 		return %res;
diff --git a/whoseip/whoseip.pl b/whoseip/whoseip.pl
index aa55770..625f441 100644
--- a/whoseip/whoseip.pl
+++ b/whoseip/whoseip.pl
@@ -468,8 +468,12 @@ sub serve {
 
     if ($term =~ /^${ipv4rx}$/) {
 	if (defined($dbf)) {
-	    %res = ipdb_lookup($dbf, $term);
-	    if (defined($res{country})) {
+	    eval {
+		%res = ipdb_lookup($dbf, $term);
+	    };
+	    if ($@) {
+		error("cache lookup failure: $@");
+	    } elsif (defined($res{country})) {
 		$res{status} = 'OK';
 		unless (defined($res{cidr})) {
 		    $res{cidr} = Net::CIDR::addrandmask2cidr($res{network},
@@ -500,10 +504,15 @@ sub serve {
 		$res{status} = 'OK';
 		if (defined($dbf)) {
 		    foreach my $cidr (split /,/, $res{cidr}) {
-			ipdb_insert($dbf, $cidr, uc $res{country},
-				    { cidr => $res{cidr},
-				      server => $res{server},
-				      port => $res{port} });
+			eval {
+			    ipdb_insert($dbf, $cidr, uc $res{country},
+					{ cidr => $res{cidr},
+					  server => $res{server},
+					  port => $res{port} });
+			};
+			if ($@) {
+			    error("can't cache $cidr: $@");
+			}
 		    }
 		}
 	    }
@@ -608,7 +617,7 @@ sub getsegm {
     return $res;
 }
 
-sub output {
+sub expandout {
     my $s = shift;
     my %esctab = (a => "\a",
 		  b => "\b",
@@ -624,24 +633,24 @@ sub output {
     print $s;
 }
 
-sub format_out {
+sub print_result {
     my $fmt = shift;
     local %_ = @_;
 
     while ($fmt =~ /(.*?)\$\?\{(\w+)\}(.*)/s) {
-	output($1);
+	expandout($1);
 	my $v = $2;
 	$fmt = $3;
 	my $t = getsegm(\$fmt);
 	my $f;
 	$f = getsegm(\$fmt) if ($fmt =~ /^\{/);
 	if (defined($_{$v})) {
-	    format_out($t, @_);
+	    print_result($t, @_);
 	} elsif (defined($f)) {
-	    format_out($f, @_);
+	    print_result($f, @_);
 	}
     }
-    output($fmt);
+    expandout($fmt);
 }
 
 sub docgi {
@@ -674,7 +683,7 @@ sub docgi {
 	    %res = (status => 'BAD', diag => 'search term invalid or missing');
 	}
     }
-    format_out($fmt, %res);
+    print_result($fmt, %res);
 }
 
 # #######################################################################
@@ -736,7 +745,12 @@ GetOptions("h" => sub {
 if (defined($dbfile)) {
     $dbfile .= "whoseip.db" if (-d $dbfile);
     $dbopt{debug} = $debug;
-    $dbf = ipdb_open($dbfile, %dbopt);
+    eval {
+	$dbf = ipdb_open($dbfile, %dbopt);
+    };
+    if ($@) {
+	error("can't open cache file $dbfile: $@");
+    }
 }
 
 if (defined($dbexport)) {
@@ -822,13 +836,13 @@ if ($fastcgi) {
         my $n = 1;
         while (<>) {
             chomp;
-	    format_out($output_format, serve($_), item => $n++);
+	    print_result($output_format, serve($_), item => $n++);
             last if $single_query;
         }
     } else {
         my $n = 1;
 	foreach my $term (@ARGV) {
-	    format_out($output_format, serve($term), item => $n++);
+	    print_result($output_format, serve($term), item => $n++);
 	}
     }
 }
@@ -1173,6 +1187,14 @@ Where the information was obtained from.  B<QUERY>, if it was retrieved
 from a remote B<whois> server and B<CACHE>, if it was read from the
 cache database.
 
+=item B<${timestamp}>
+
+Time when the record entered the database (if obtained from cache).
+
+=item B<${ttl}>
+
+Cache entry time to live (if obtained from cache).
+
 =item B<${server}>
 
 Whois server that returned the information.
@@ -1181,6 +1203,14 @@ Whois server that returned the information.
 
 Port used to query the whois server.
 
+=item B<${package}>
+
+Name of the package (B<whoseip>).
+
+=item B<${version}>
+
+B<Whoseip> version number.
+
 =back
 
 If a macro is not defined, the corresponding reference expands to 
@@ -1203,6 +1233,41 @@ The escape sequences B<\a>, B<\b>, B<\e>, B<\f>, B<\n>, B<\r>,
 B<\t>, and B<\v> are replaced according to their traditional
 meaning.
 
+=head1 EXIT CODES
+
+=over 4
+
+=item 0
+
+Normal termination.
+
+=item 64
+
+Command line usage error.
+
+=item 65
+
+Input data format error.
+
+=item 66
+
+Input file cannot be opened.
+
+=item 70
+
+Internal software error (please report that!)
+
+=item 72
+
+Critical OS file is missing.  Usually that means that B<FastCGI mode> has been
+requested, but the B<FCGI> module couldn't be loaded.
+
+=item 73
+
+Can't create output file.
+
+=back
+
 =head1 BUGS
 
 Only IPv4 is supported.