#! /usr/bin/perl
# Copyright (C) 2014 Sergey Poznyakoff <gray@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use Getopt::Long qw(:config gnu_getopt no_ignore_case);
use IO::Socket;
use Pod::Usage;
use Pod::Man;
use Socket qw(:DEFAULT :crlf inet_ntoa);
use Net::CIDR;
use Whoseip::DB qw(:all);

use constant EX_OK           => 0;
use constant EX_USAGE        => 64;    # command line usage error
use constant EX_DATAERR      => 65;    # data format error
use constant EX_NOINPUT      => 66;    # cannot open input file
use constant EX_SOFTWARE     => 70;    # internal software error (not used yet)
use constant EX_OSFILE       => 72;    # critical OS file missing
use constant EX_CANTCREAT    => 73;    # can't create (user) output file

my $progname;      # This script name;
($progname = $0) =~ s/.*\///;

my $progdescr = "Identifies IP addresses";
my $debug;
my @ipv4list;

my $ipv4rx = '\d{1,3}((\.\d{1,3}){3})';
my $delim = $LF;   # Output delimiter

my $dbf;
my $dbfile;
my %dbopt;

my %fmtab = (unix => '${status} $?{diag}{${diag}}{${country} ${cidr} ${range} ${count}}
',
             cgi => 'Content-Type: text/xml

<?xml version="1.0" encoding="US-ASCII"?>
<whoseip xmlns:whoseip="http://man.gnu.org.ua/8/whoseip">
  <whoseip:status>${status}</whoseip:status>
  $?{diag}{<whoseip:diag>${diag}</whoseip:diag>}{<whoseip:country>${country}</whoseip:country>
  <whoseip:cidr>${cidr}</whoseip:cidr>
  <whoseip:range>${range}</whoseip:range>
  <whoseip:count>${count}</whoseip:count>}
  $?{term}{<whoseip:term>${term}</whoseip:term>}
</whoseip>
'
);

sub error {
    my $msg = shift;
    local %_ = @_;
    print STDERR "$progname: " if defined($progname);
    print STDERR "$_{prefix}: " if defined($_{prefix});
    print STDERR "$msg\n"
}

sub debug {
    my $l = shift;
    error(join(' ',@_), prefix => 'DEBUG') if $debug >= $l;
}

sub abend {
    my $code = shift;
    print STDERR "$progname: " if defined($progname);
    print STDERR "@_\n";
    exit $code;
}

sub read_config_file($) {
    my $config_file = shift;
    print STDERR "reading $config_file\n" if ($debug);
    open(my $fd, "<", $config_file) or die("cannot open $config_file: $!");
    while (<$fd>) {
        chomp;

        s/\s+$//;

	if (/\\$/) {
	    chop;
	    $_ .= <$fd>;
	    redo;
	}

        s/^\s+//;
        s/\s+=\s+/=/;
        s/#.*//;
        next if ($_ eq "");
        unshift(@ARGV, "--$_");
    }
    close $fd;
}

sub read_ipv4list {
    my $file = shift;
    open(my $fd, "<", $file)
	or abend(EX_NOINPUT, "can't open $file for reading: $!");
    my $line = 0;
    @ipv4list = ();
    while (<$fd>) {
	++$line;
	chomp;
	s/#.*//;
	s/^\s+//;
	s/\s+$//;
	next if ($_ eq "");

	unless (/^([\d\.]+)\/(\d+)\s+([\w\.]+)$/) {
	    error("$file:$line: malformed line");
	    next;
	}
	my $srv = $3;
	next if $srv eq 'UNKNOWN';
	my $msk = $2;
	my $ip = str2ipv4($1);
	$srv = "whois.$srv.net" unless ($srv =~ /\./);

	push @ipv4list, [ $ip,
			  (0xffffffff^(0xffffffff>>$msk)),
			  $srv ];
    }

    close $fd;
}

sub str2ipv4 {
    my $ipstr = shift;
    my @ip = split(/\./, $ipstr);
    return ($ip[0] << 24) + ($ip[1] << 16) + ($ip[2] << 8) + $ip[3];
}

sub range2count {
    my $count = 0;
    foreach my $arg (@_) {
	my @a = split /-/, shift;
	next unless $#a == 1;
	$count += str2ipv4($a[1]) - str2ipv4($a[0]) + 1;
    }
    return $count;
}

sub cidr_to_range {
    my @a;

    @a = sort { $a->[0] <=> $b->[0] }
         map {
	     map { [ map { str2ipv4($_) } split(/-/, $_, 2) ] }
	         Net::CIDR::cidr2range($_) 
	 } split /,/, shift;
    
    for (my $i = $#a; $i > 0; $i--) {
	if ($a[$i]->[0] == $a[$i-1]->[1] + 1) {
	    $a[$i-1]->[1] = $a[$i]->[1];
	    splice @a, $i, 1;
	}
    }
    return join ',', map { inet_ntoa(pack('N', $_->[0])) . '-' .
			       inet_ntoa(pack('N', $_->[1])) } @a;
}

# ############
# ARIN
# ############
sub arin_fmt {
    my $q = shift;
    return "n + $q";
}

sub arin_decode {
    my ($input, $ref) = @_;

    return if ($input =~ /^#/ || $input eq '');

    if ($input =~ /^NetRange:\s+(.+)/) {
	my $r = $1;
	$r =~ s/\s+//g;
	my $n = range2count($r);
	if (!defined($ref->{count}) || $ref->{count} > $n) {
	    $ref->{range} = $r;
	    $ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
	    $ref->{count} = $n;
	    delete $ref->{country}
	}
    } elsif ($input =~ /^Country:\s+(.+)/ && !defined($ref->{country})) {
	$ref->{country} = $1;
    }
}

# ############
# RIPE
# ############
use constant RIPE_INIT => 0;
use constant RIPE_TEXT => 1;
use constant RIPE_IGNR => 2;

sub ripe_fmt {
    # From the RIPE Database FAQ:
    #
    # Q: Why did I receive an Error 201: Access Denied? 
    #
    # * You (or your application) performed too many queries that
    #   returned contact information (e.g. person or role objects) from the
    #   RIPE Database. There is a daily limit on the amount of personal
    #   data returned as described in the Acceptable Use Policy.
    #
    # * Even if you queried for other types of objects, the associated
    #   contact information is returned by default. To avoid this situation
    #   please use the "-r" flag to prevent any associated contact
    #   information from being returned.
    my $q = shift;
    return "-r $q";
}

sub ripe_decode {
    my ($input, $ref) = @_;

    error("WHOIS($ref->{server}:$ref->{port}): $1")
	if ($input =~ /^%ERROR:(.+)/);

    return if ($input =~ /^%/);
    
    if ($ref->{state} == RIPE_INIT) {
	if ($input eq '') {
	    return;
	} else {
	    $ref->{state} = RIPE_TEXT;
	}
    }

    if ($ref->{state} == RIPE_TEXT) {
	if ($input =~ /^inetnum:\s+(.+)/) {
	    my $r = $1;
	    $r =~ s/\s+//g;
	    $ref->{range} = $r;
	    $ref->{count} = range2count($r);
	    $ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
	} elsif ($input =~ /^country:\s+(.+)/) {
	    $ref->{country} = $1;
	} elsif ($input =~ /^netname:\s+(.+)-TRANSFERRED.*/) {
	    # A kludge to handle networks transferred to another RIR
	    # E.g.: netname: AFRINIC-NET-TRANSFERRED-20050223
	    my $s = $1;
	    $s =~ s/-/./g;
	    $ref->{referto} = "whois.$s:43";
	} elsif ($input eq '') {
	    $ref->{state} = RIPE_IGNR;
	}
    }
}

# ############
# LACNIC
# ############
sub lacnic_decode {
    my ($input, $ref) = @_;

    return if ($input =~ /^%/);

    if ($ref->{state} == RIPE_INIT) {
	if ($input eq '') {
	    return;
	} else {
	    $ref->{state} = RIPE_TEXT;
	}
    }

    if ($ref->{state} == RIPE_TEXT) {
	if ($input =~ /^inetnum:\s+(.+)/) {
	    my $cidr = $1;
	    if ($cidr =~ m#^(\d{1,3})/(\d+)#) {
		$cidr = "$1.0.0.0/$2";
	    } elsif ($cidr =~ m#^(\d{1,3}\.\d{1,3})/(\d+)#) {
		$cidr = "$1.0.0/$2";
	    } elsif ($cidr =~ m#^(\d{1,3}\.\d{1,3}\.\d{1,3})/(\d+)#) {
		$cidr = "$1.0/$2";
	    }
	    $ref->{cidr} = $cidr;
	    $ref->{range} = cidr_to_range($cidr);
	    $ref->{count} = range2count($ref->{range});
	} elsif ($input =~ /^country:\s+(.+)/) {
	    $ref->{country} = $1;
	} elsif ($input eq '') {
	    $ref->{state} = RIPE_IGNR;
	}
    }
}

# ###################
# rwhois.gin.ntt.net
# ###################
sub ntt_decode {
    my ($input, $ref) = @_;
    if ($input =~ /^\s+(${ipv4rx}\s*-\s*${ipv4rx})/) {
	my $r = $1;
	$r =~ s/\s+//g;
	my $c = range2count($r);
	if (!defined($ref->{count}) || $ref->{count} > $c) {
	    $ref->{count} = $c;
	    $ref->{range} = $r;
	    $ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
	    $ref->{country} = 'US';
	}
    }
}

# ############
# TWNIC
# ############
sub twnic_decode {
    my ($input, $ref) = @_;
    if ($input =~ /^\s+Netblock:\s+(.+)/) {
	my $r = $1;
	$r =~ s/\s+//g;
	$ref->{range} = $r;
	$ref->{count} = range2count($r);
	$ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
	$ref->{country} = 'TW';
    }
}

###################
# whois.nic.ad.jp
###################
sub nic_ad_jp_fmt {
    my $q = shift;
    return "NET $q/e";
}

sub nic_ad_jp_decode {
    my ($input, $ref) = @_;
    if ($input =~ /^a\.\s+\[Network Number\]\s+(.+)/) {
	$ref->{cidr} = $1;
	$ref->{range} = cidr_to_range($ref->{cidr});
	$ref->{count} = range2count($ref->{range});
	$ref->{country} = 'JP';
    }
}

###################
# whois.nic.or.kr
###################
sub nic_or_kr_decode {
    my ($input, $ref) = @_;
    if ($input =~ /^IPv4 Address\s*:\s+(${ipv4rx}\s*-\s*${ipv4rx})/) {
	my $r = $1;
	$r =~ s/\s+//g;
	my $c = range2count($r);
	if (!defined($ref->{count}) || $ref->{count} > $c) {
	    $ref->{count} = $c;
	    $ref->{range} = $r;
	    $ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
	    $ref->{country} = 'KR';
	}
    }
}

sub nobistech_decode {
    my ($input, $ref) = @_;

    if ($input =~ /network:IP-Network:(.+)/) {
	$ref->{cidr} = $1;
	$ref->{range} = cidr_to_range($1);
	$ref->{count} = range2count($ref->{range});
    } elsif ($input =~ /network:Country-Code:(.+)/) {
	$ref->{country} = $1;
    }
}

	
# #######################################################################
# Server table
# #######################################################################

my %srvtab = (
    'whois.arin.net' => { q => \&arin_fmt,  d => \&arin_decode },
    'whois.lacnic.net' => { d => \&lacnic_decode },
    'whois.ripe.net' => { q => \&ripe_fmt, d => \&ripe_decode },
    'rwhois.gin.ntt.net' => { d => \&ntt_decode },
    'whois.twnic.net' => { d => \&twnic_decode },
    'whois.nic.ad.jp' => { q => \&nic_ad_jp_fmt, d => \&nic_ad_jp_decode },
    'whois.nic.br' => { d => \&lacnic_decode },
    'whois.nic.or.kr' => { d => \&nic_or_kr_decode },
    'rwhois.nobistech.net' => { d => \&nobistech_decode }
);

sub format_query {
    my ($srv, $term) = @_;
    if (defined($srvtab{$srv}{q})) {
	return &{$srvtab{$srv}{q}}($term);
    } else {
	return $term;
    }
}

sub findsrv {
    my $ip = str2ipv4(shift);

    foreach my $r (@ipv4list) {
	debug(3, "findsrv: $ip $r->[0]/$r->[1]");
	return $r->[2] if ($ip & $r->[1]) == $r->[0];
    }
    return undef;
}

sub whois($$) {
    my $ip = shift;
    my $server = shift;
    my $port = 43;

    if ($server =~ /(.+):(.+)/) {
	$server = $1;
	$port = $2;
    }

    debug(1,"querying $ip from $server:$port");

    my $sock = new IO::Socket::INET (PeerAddr => $server,
				     PeerPort => $port,
				     Proto => 'tcp');
    my $expiration = undef;
    my @collect;

    unless ($sock) {
	error("could not connect to $server:$port: $!");
	return undef;
    }

    print $sock format_query($server, $ip)."\n";
    my $decode;
    if (defined($srvtab{$server}{d})) {
	$decode = $srvtab{$server}{d};
    } else {
	$decode = \&ripe_decode;
    }

    local $/ = LF;
    my %res = (server => $server, port => $port, term => $ip);
    while (<$sock>) {
	s/\s*$CR?$LF$//;
	debug(4, "RECV: $_");
	if (/%% referto: whois -h (\S+) -p (\S+)/) {
	    $res{referto} = "$1:$2";
	    debug(1, "found reference to $res{referto}"); 
	} elsif (m#ReferralServer: r?whois://(.+)#) {
	    $res{referto} = $1;
	    $res{referto} =~ s#/$##;
	    debug(1, "found reference to $res{referto}"); 
	} else {
	    &{$decode}($_, \%res);
	}
    }
    close $sock;
    return %res;
}

sub serve {
    my $term = shift;
    my %res;

    if ($term =~ /^${ipv4rx}$/) {
	if (defined($dbf)) {
	    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},
							     $res{netmask});
		}
		$res{range} = cidr_to_range($res{cidr});
		$res{count} = range2count($res{range});
		$res{term} = $term;
                $res{source} = 'CACHE';
		return %res;
	    }
	}

	my $srv = findsrv($term);
	if (defined($srv) && $srv ne 'UNKNOWN') {
	    my %prev;
	    while (%res = whois($term, $srv),
		   && defined($res{referto})) {
		%prev = %res if $res{status} = 'OK';
		$srv = $res{referto};
	    }
	    %res = %prev
		if (!defined($res{country}) && defined($prev{country}));
	    if (!defined($res{country})) {
		$res{status} = 'NO';
		$res{diag} = 'IP unknown';
	    } else {
		$res{status} = 'OK';
		if (defined($dbf)) {
		    foreach my $cidr (split /,/, $res{cidr}) {
			eval {
			    ipdb_insert($dbf, $cidr, uc $res{country},
					{ cidr => $res{cidr},
					  server => $res{server},
					  port => $res{port} });
			};
			if ($@) {
			    error("can't cache $cidr: $@");
			}
		    }
		}
	    }
	} else {
	    $res{status} = 'NO';
	    $res{diag} = 'whois server unknown';
	}
    } else {
	$res{status} = 'BAD';
	$res{diag} = 'invalid input';
    }
    $res{source} = 'QUERY';
    $res{package} = 'whoseip';
    $res{version} = $Whoseip::DB::VERSION;
    $res{term} = $term;
    return %res;
}

# #######################################################################
# Create a copy of this program with ipv4list embedded
# #######################################################################
sub whoseip_dump {
    my ($opt,$file) = @_;

    open(my $ifd, "<", $0)
	or abend(EX_NOINPUT, "can't open $0 for reading");
    open(my $ofd, ">", $file)
	or abend(EX_CANTCREAT, "can't open $file for writing");
    my $zapto;
    my $line = 0;
    while (<$ifd>) {
	++$line;
	if (defined($zapto)) {
	    $zapto = undef if /$zapto/;
	    next;
	}
	if (/^my \@ipv4list\s*(.*)/) {
	    my $tail = $1;
	    if ($tail =~ /^=\s*\(/) {
		$zapto = '^\);$';
	    } elsif ($tail !~ /^;/) {
		error("$file:$line: unrecognized @ipv4list initializer");
		print $ofd $_;
		next;
	    }
	    print $ofd "my \@ipv4list = (\n";
	    foreach my $x (@ipv4list) {
		print $ofd "[ $x->[0], $x->[1], '$x->[2]' ],\n";
	    }
	    print $ofd ");\n";
	} else {
	    print $ofd $_;
	}
    }
    close $ifd;
    close $ofd;
    exit 0;
}

# #######################################################################
# Output functions
# #######################################################################

sub read_format {
    my $file = shift;
    open(my $fd, "<", $file)
	or die "can't open $file for reading";
    my $res;
    while (<$fd>) {
	chomp;
	if (/\\$/) {
	    chop;
	    $_ .= <$fd>;
	    redo;
	}
	next if /^#/;
	$res .= "$_\n";
    }
    close $fd;
    return $res;
}

sub getsegm {
    my $sref = shift;
    my $s = ${$sref};
    my $level = 0;
    my $res;
    while ($s =~ /(.*?[{}])(.*)/s) {
	$res .= $1;
	$s = $2;
	if ($res =~ /[\$\?l]\{$/s) {
	    if ($s =~ /(\w+\})(.*)/s) {
		$res .= $1;
		$s = $2;
	    }
	} elsif ($res =~ /{$/) {
	    ++$level;
	} elsif ($res =~ /}$/) {
	    last if (--$level == 0);
	}
    }
    ${$sref} = $s;
    $res =~ s/^\{//s;
    $res =~ s/\}$//s;
    return $res;
}

sub expandout {
    my $s = shift;
    my %esctab = (a => "\a",
		  b => "\b",
		  e => "\e",
		  f => "\f",
		  n => "\n",
		  r => "\r",
		  t => "\t",
		  v => "\v");
    $s =~ s/\$l{(\w+)\}/length($_{$1})/sgex;
    $s =~ s/\$\{(\w+)\}/$_{$1}/sgex;
    $s =~ s/\\([\\abefnrtv])/$esctab{$1}/sgex;
    print $s;
}

sub print_result {
    my $fmt = shift;
    local %_ = @_;

    while ($fmt =~ /(.*?)\$\?\{(\w+)\}(.*)/s) {
	expandout($1);
	my $v = $2;
	$fmt = $3;
	my $t = getsegm(\$fmt);
	my $f;
	$f = getsegm(\$fmt) if ($fmt =~ /^\{/);
	if (defined($_{$v})) {
	    print_result($t, @_);
	} elsif (defined($f)) {
	    print_result($f, @_);
	}
    }
    expandout($fmt);
}

sub docgi {
    my ($fmt, $env) = @_;
    my $term;
    my %res;
    
    if ($env->{QUERY_STRING} =~ /^$ipv4rx$/) {
	$term = $env->{QUERY_STRING};
    } else {
	my %q = map { /(.+?)=(.*)/ ? ($1 => $2) : ($1 => 1); } 
                    split(/\&/, $env->{QUERY_STRING});
	if (defined($q{fmt})) {
	    if (defined($fmtab{$q{fmt}})) {
		if ($fmtab{$q{fmt}} =~ /^Content-Type:/) {
		    $fmt = $fmtab{$q{fmt}};
		} else {
		    %res = (status => 'BAD', diag => 'invalid format')
		}
	    } else {
		%res = (status => 'BAD', diag => 'format undefined');
	    }
        }
	$term = $q{ip} if defined($q{ip});
    }
    unless (defined($res{status})) {
	if (defined($term)) {
	    %res = serve($term);
	} else {
	    %res = (status => 'BAD', diag => 'search term invalid or missing');
	}
    }
    print_result($fmt, %res);
}

# #######################################################################
# Main
# #######################################################################

my $output_format;
my $fastcgi;
my $single_query;
my $dbexport;
my $dbimport;

if (defined($ENV{WHOSEIP_CONF})) {
    read_config_file($ENV{WHOSEIP_CONF});
} elsif (-r "/etc/whoseip.conf") {
    read_config_file("/etc/whoseip.conf");
}

GetOptions("h" => sub {
		    pod2usage(-message => "$progname: $progdescr",
			      -exitstatus => EX_OK);
	   },
	   "help" => sub {
		    pod2usage(-exitstatus => EX_OK, -verbose => 2);
	   },
	   "usage" => sub {
		    pod2usage(-exitstatus => EX_OK, -verbose => 0);
	   },
	   "debug|d+" => \$debug,
	   "ip-list|i=s" => sub { read_ipv4list($_[1]); },
	   "dump|D=s" => \&whoseip_dump,
           "define-format=s" => sub {
		my @a = split /\s*=\s*/, $_[1], 2;
		$fmtab{$a[0]} = $a[1];
	    },
           "format|f=s" => \$output_format,
           "format-file|formfile|F=s" => sub {
		if ($_[1] =~ /=/) {
		    my @a = split /\s*=\s*/, $_[1], 2;
		    $fmtab{$a[0]} = read_format($a[1]);
		} else {
		    $output_format = read_format($_[1]); 
	        }
	   },
           "fastcgi:s" => \$fastcgi,
           "cache-file|c:s" => \$dbfile,
           "no-cache|N" => sub { $dbfile = undef; },
           "single-query" => \$single_query,
           "cache-ttl|ttl|t=n" => sub {
                $dbopt{ttl} => $_[1];
           },
           "cache-mode=s" => sub {
                $dbopt{mode} = $_[1];
           },
           "export" => \$dbexport,
           "import" => \$dbimport,
) or exit(EX_USAGE);

if (defined($dbfile)) {
    $dbfile .= "/whoseip.db" if (-d $dbfile);
    $dbopt{debug} = $debug;
    eval {
	$dbf = ipdb_open($dbfile, %dbopt);
    };
    if ($@) {
	error("can't open cache file $dbfile: $@");
    }
}

if (defined($dbexport)) {
    abend(EX_USAGE, "--export requires --cache-file") unless defined($dbf);
    abend(EX_USAGE, "too many arguments") if ($#ARGV > 0);
    my $fd;
    if ($#ARGV == 0) {
	open($fd, '>', $ARGV[0]) or
	    abend(EX_CANTCREAT, "can't open $ARGV[0] for writing: $!");
    }
    ipdb_export($dbf, $fd);
    ipdb_close($dbf);
    exit(EX_OK);
}

if (defined($dbimport)) {
    abend(EX_USAGE, "--import requires --cache-file") unless defined($dbf);
    abend(EX_USAGE, "too many arguments") if ($#ARGV > 0);
    my $fd;
    if ($#ARGV == 0) {
	open($fd, '<', $ARGV[0]) or
	    abend(EX_NOINPUT, "can't open $ARGV[0] for reading: $!");
    }
    ipdb_import($dbf, $fd);
    ipdb_close($dbf);
    exit(EX_OK);
}

if (defined($fastcgi)) {
    if ($fastcgi eq '') {
        $fastcgi = 1;
    } else {
        my @suf = split /\s+/, $fastcgi;
        $fastcgi = undef;
        foreach my $s (@suf) {
            if ($0 =~ /$s$/) {
                $fastcgi = 1;
                last;
            }
        }
    }
} else {
    $fastcgi = $0 =~ /\.fcgi$/;
}

if (defined($output_format) && $output_format =~ /@(.+)/) {
    abend(EX_USAGE, "format $1 not defined") unless defined $fmtab{$1};
    $output_format = $fmtab{$1};
}

if ($fastcgi) {
    eval {
        require FCGI;
        1;
    } or do {
        my $msg = $@;
        if ($debug) {
            abend(EX_OSFILE, "can't load CGI::Fast: $@");
        } else {
            abend(EX_OSFILE, "can't load CGI::Fast");
        }
    };

    $output_format = $fmtab{cgi} unless defined($output_format);
    my $req = FCGI::Request();
    while ($req->Accept() >= 0) {
	docgi($output_format, $req->GetEnvironment());
    }
} elsif ($ENV{GATEWAY_INTERFACE} =~ m#CGI/\d+\.\d+#) {
    $output_format = $fmtab{cgi} unless defined($output_format);
    docgi($output_format, \%ENV);
} else {
    my $term;
    my %res;

    ipdb_locker($dbf, lock => 'shared') if (defined($dbf));
    $output_format = $fmtab{unix} unless defined($output_format);
    if ($#ARGV == -1) {
	unless (-t *STDIN) {
	    local $/ = CRLF;
	    $delim = "$CR$LF";
	}
        my $n = 1;
        while (<>) {
            chomp;
	    print_result($output_format, serve($_), item => $n++);
            last if $single_query;
        }
    } else {
        my $n = 1;
	foreach my $term (@ARGV) {
	    print_result($output_format, serve($term), item => $n++);
	}
    }
}

ipdb_close($dbf) if defined($dbf);

__END__
=head1 NAME

whoseip - return information about IP address

=head1 SYNOPSIS

B<whoiseip>
[B<-dhN>]
[B<-F> I<FILE>]    
[B<-D> I<FILE>]
[B<-i> I<FILE>]
[B<--cache-file=>I<FILE>]
[B<--debug>]
[B<--define-format=>I<NAME>B<=>I<TEXT>]
[B<--dump=>I<FILE>]
[B<--export>]    
[B<--fastcgi=>[I<SUFFIX...>]]
[B<--format=>I<TEXT>]
[B<--format-file=>[I<NAME>B<=>]I<FILE>]
[B<--formfile=>I<FILE>]
[B<--help>]
[B<--import>]    
[B<--ip-list=>I<FILE>]
[B<--no-cache>]
[B<--single-query>]    
[B<--usage>] 
[I<IPADDR>...]    

=head1 DESCRIPTION

For each IP address, B<whoseip> returns the country it is located in
(a ISO 3166-1 code), the network it belongs to and the number of addresses
in the network.

The program can operate in several modes: as a standalone command line tool,
or as a B<CGI> or B<Fast CGI> process.    

If the program name ends in B<.fcgi> the B<Fast CGI> mode is enabled.
This mode is also enabled if the command line option B<--fastcgi> is
given without arguments, or if the program name ends in one of the
suffixes supplied in the argument to this option (a whitespace-separated
list).  In this mode, the IP address to look for is taken from the B<URI>
parameter B<ip>.  Additional parameter B<fmt> can be used to supply the
name of the desired output format.  Its value must be either a name of one of
the built-in formats, or must be defined using the B<--define-format>
option (see below).  As a shortcut, the invocation command line containing
an IP alone is also recognized.    
    
Otherwise, when one or more IP addresses are given in the command line,
B<whoseip> prints the data for each of them on the standard output.
This is B<command line> mode.

If called without arguments, the program checks if the environment variable
B<GATEWAY_INTERFACE> is defined and contains B<CGI/I<V>> (where I<V> is the
version number).  If so, it assumes B<CGI> mode.  In this mode the command
line is parsed the same way as in B<Fast CGI> mode.

If B<GATEWAY_INTERFACE> is not set, the program reads IP addresses from
input (one per line) and prints replies for each of them.  This is B<inetd
mode>.

To summarize:

=over 4

=item 1.

Start it from the command line with one or more IPs given as arguments, if
you wish to get info about these IPs.

=item 2.

Add it to B</etc/inetd.conf> if you want to query it remotely as a service,
e.g.:

    whois stream tcp nowait nobody /usr/bin/whoseip

=item 3.

Copy it to your B<cgi-bin> directory to use it with a B<http> server as a
B<CGI>.

=item 4.

Link it to B<whoseip.fcgi> to use it as a B<FastCGI> application (or use
the B<--fastcgi> option).

=back    

Output formats are configurable and depend on the mode B<whoseip> runs
in.  In command line and inetd modes, the default output format is:

=over 4
    
B<OK> I<COUNTRY> I<CIDR> I<RANGE> I<COUNT>

=back

where I<COUNTRY> is country code, I<CIDR> is network block in CIDR notation,
I<RANGE> is network block as a range of IP addresses, and I<COUNT> is
number of IP address in the network block.

If the specified IP address is not found, the reply is

=over 4

B<NO> I<TEXT>

=back

where I<TEXT> is a human-readable explanatory message.

If the input is invalid, the reply is:    

=over 4

B<BAD> I<TEXT>

=back

In B<CGI> and B<FastCGI> modes, the output is represented as XML, as
shown in the example below:    

    <?xml version="1.0" encoding="US-ASCII"?>
    <whoseip xmlns:whoseip="http://man.gnu.org.ua/8/whoseip">
      <whoseip:status>OK</whoseip:status>
      <whoseip:country>US</whoseip:country>
      <whoseip:cidr>192.0.2.0/24</whoseip:cidr>
      <whoseip:range>192.0.2.0-192.0.2.255</whoseip:range>
      <whoseip:count>255</whoseip:count>
      <whoseip:term>192.0.2.10</whoseip:term>
    </whoseip>

The following example illustrates the reply if the IP is not found:

    <?xml version="1.0" encoding="US-ASCII"?>
    <whoseip xmlns:whoseip="http://man.gnu.org.ua/8/whoseip">
      <whoseip:status>NO</whoseip:status>
      <whoseip:diag>IP unknown</whoseip:diag>
      <whoseip:term>43.0.0.1</whoseip:term>
   </whoseip>
    
See the section B<FORMAT> below for a discussion on how to customize
output formats.

=head2 Caching

To minimize number of queries to external B<whois> servers, it is recommended
to use a cache database.  It is enabled by using the B<--cache-file=I<FILENAME>>
option (or B<cache-file> configuration file statement).  A B<time to live>
for the cached records can be set using the B<--cache-ttl> option.

=head1 OPTIONS

=over 4

=item B<--cache-file=>I<FILE>

Cache retrieved data in file I<FILE>.    

=item B<-D>, B<--dump=>I<FILE>

Dump the program to I<FILE>.  This is normally done to update the
built-in server list, e.g.:

     whoseip --ip-list=ip_del_list --dump=whoseip.new

Note, that B<--dump> must be last option in the command line.
    
=item B<-d>, B<--debug>

Increase debugging verbosity.

=item B<--define-format=>I<NAME>B<=>I<TEXT>

Define a named format I<NAME> to be I<TEXT>.  Two names are predefined:
format B<cgi> is used to respond to B<CGI> or B<FastCGI> requests, and
format B<unix> is used when serving requests coming from command line or
in inetd mode.  See the section B<FORMAT>, for a detailed discussion.
    
=item B<--export>

Export the IP database into portable ASCII dump file.  If a single argument
is supplied, it gives the name of the output file.  In the absence of
arguments, standard output is used.

The created file can be transmitted over the network to hosts of another
architecture and used there to recreate the database via
B<whoseip --import>.

=item B<--fastcgi=>[I<SUFFIX...>]

When used without argument, forces B<FastCGI> mode.  If an argument is given,
it is treated as a whitespace-separated list of suffixes.  In this case,
FastCGI mode is enabled if the program name ends in one of these suffixes.

If this option is not given, FastCGI is enabled if the program name ends
in B<.fcgi>.

=item B<-f>, B<--format=>I<STRING>

Sets output format string.  If I<STRING> begins with a B<@>, it is
a reference to a named format string (either built-in one or a one
created using the B<--define-format> option), and is replaced with
the value of the format referred to.  For example, B<--format=@cgi>
instructs the program to use B<cgi> format.
    
=item B<-F>, B<--formfile>, B<--format-file=>[I<NAME>B<=>]I<FILE>

Read output format string from I<FILE>.  If I<NAME> is supplied, assign the
format string to the named format.  See the section B<FORMAT>, for a
detailed discussion.
    
=item B<-i>, B<--ip-list=>I<FILE>

Read the table of B<whois> servers from I<FILE>.  Each line in I<FILE>
must have the following format:

I<CIDR> I<SERVER>    

Comments are introduced with a B<#> sign.  Empty lines are ignored.

Without this option, B<whoseip> uses the built-in list of servers.

=item B<--import>

Import data from the file given as the first argument into the database.  If
no argument is given, read from standard input.  The input must be a valid
B<whoseip> database dump, as produced by B<whoseip --export>.

=item B<-N>, B<--no-cache>

Disable caching (this is the default).

=item B<--single-query>

This option is valid only in B<inetd mode>.  It instructs B<whoseip> to
terminate after replying to the first query.

=back

The following options cause the program to display informative text and
exit:

=over 4

=item B<-h>

Show a short usage summary.

=item B<--help>

Show man page.

=item B<--usage>

Show a concise command line syntax reminder.

=back    

=head1 CONFIGURATION FILE

If the file B</etc/whoseip.conf> exists, it is read before processing
command line options.  If the environment variable B<WHOSEIP_CONF> is
set, its value is used as the file name, instead of B</etc/whoseip.conf>.

The file is read line by line.  Long lines can be split over several
physical lines by inserting a backslash followed by a newline.  Empty
lines are ignored.  Comments are introduced with the B<#> character.
Anything following it up to the logical line is ignored.

Each non-empty line must contain a single long command line option,
without the leading B<-->.  Arguments must be separated from options
with an equals sign, optionally surrounded with whitespace.

For example:

    # Assume FastCGI if the program name ends in one of these
    # suffixes
    fastcgi = .fcgi .pl
    # Define output format for CGI and FastCGI modes
    define-format  =  cgi=Content-Type: application/json\n\
    \n\
    { "status": "${status}", \
    $?{diag}{"diag": "${diag}"}{\
     "country": "${country}",\
     "cidr": "${cidr}",\
     "range": "${range}",\
     "count": "${count}"}\
    $?{term}{, "term": "${term}" } }\n

=head1 FORMAT

Output formats can be redefined using B<--define-format>, B<--format>,
and B<--format-file> command line options, or corresponding configuration
file keywords.

The format string supplied with this options (or in the input file, in
case of the B<--format-file> option) can contain the following macro
references, which are replaced with the corresponding piece of information
on output:

=over 4

=item B<${status}>

The reply status: B<OK>, if the information has been retrieved,
B<NO>, if it was not, and B<BAD>, if the input was invalid.

=item B<${diag}>

Contains explanatory text if B<${status}> is B<NO> or B<BAD>.  If
it is B<OK>, this macro is not defined.

=item B<${item}>

Ordinal number of the request being served.  Not defined in B<CGI> and
B<FastCGI> modes.

=item B<${term}>

The input IP address.

=item B<${cidr}>

The network IP belongs to, as a B<CIDR>.

=item B<${range}>

The network, as a range of IP addresses.

=item B<${count}>

Number of IP addresses in the network.

=item B<${country}>

ISO 3166-1 code of the country where IP address is located.

=item B<${source}>

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.

=item B<${port}>

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 
empty string.

Conditional expressions evaluate depending on whether a macro is defined.
The syntax of a conditional expression is:

=over 4

B<$?{I<NAME>}>B<{>I<TEXT-IF-TRUE>B<}>B<{>I<TEXT-IF-FALSE>B<}>

=back

Its effect is as follows: if the macro I<NAME> is defined, the
I<TEXT-IF-TRUE> is substituted, otherwise the I<TEXT-IF-FALSE>
is substituted.  Conditional expressions can be nested.

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.    

=head1 AUTHOR

Sergey Poznyakoff <gray@gnu.org>

=cut