#!/pro/bin/perl

use 5.014000;
use warnings;

our $VERSION = "0.19";
our $CMD = $0 =~ s{.*/}{}r;

sub usage {
    my $err = shift and select STDERR;
    say "usage: $CMD [--fetch] [--no-update] [--dist] [--whois] [ip|host ...]";
    say "   -f   --fetch        Fetch new ZIP sources";
    say "        --no-update    Do not update the database on new data";
    say "   -s   --short        Skip location and flags";
    say "   -d   --dist         Show distance in KM between here and there";
    say "                       will only work if LWP::UserAgent and";
    say "                       HTML::TreeBuilder are installed";
    say "   -w   --whois        Show whois information";
    say "                       will only work if Net::Whois::IP is installed";
    say "   -j   --json         Output information in JSON";
    say "   -J   --json-pretty  Output information in JSON";
    say "   -lL  --local=L      Specify local location LAT/LON";
    say "   -D   --DB=dsn       Specify geoip database DSN default: dbi:Pg:geoip";
    say "                       may be specified in \$GEOIP_DBI_DSN";
    say "        --country=c    Find CIDR's for country c";
    say "$CMD --man will show the full manual";
    say "\$GEOIP_HOST will be used if no IP or host is given";
    exit $err;
    } # usage

# Required modules
use DBI;
use Socket;
use Net::CIDR;
use Data::Dumper;
use Math::Trig;
use LWP::Simple;
use Archive::Zip;
use JSON::PP;
use Text::CSV_XS qw( csv );
use List::Util   qw( first sum );
use Getopt::Long qw(:config bundling);

# Optional modules
my $gis = eval {
    require GIS::Distance;
    GIS::Distance->new;
    };
my $use_data_peek = eval {
    require Data::Peek;
    1;
    };
my $whois = eval {
    require Net::Whois::IP;
    \&Net::Whois::IP::whoisip_query;
    };

my %conf = (
    update		=> 1,
    distance		=> 0,
    whois		=> 0,
    short		=> 0,
    json		=> 0,
    json_pretty		=> 0,
    local_location	=> undef,
    dsn			=> $ENV{GEOIP_DBI_DSN} || "dbi:Pg:dbname=geoip",
    );
getconf ();

GetOptions (
    "help|?"		=> sub { usage (0); },
    "V|version"		=> sub { say "$CMD [$VERSION]"; exit 0; },
      "man"		=> sub { pod_nroff (); },
      "info"		=> sub { pod_text  (); },

    "u|update!"		=> \$conf{update},
    "f|fetch!"		=> \$conf{fetch},
    "d|dist|distance!"	=> \$conf{distance},
    "w|whois!"		=> \$conf{whois},
    "s|short!"		=> \$conf{short},
    "j|json!"		=> \$conf{json},
    "J|json-pretty!"	=> \ my $opt_J,
    "l|local=s"		=> \$conf{local_location},

    "D|DB=s"		=> \$conf{dsn},

    # Queries
      "country=s"	=> \ my $query_c,

    "v|verbose:1"	=> \(my $opt_v = 0),
    ) or usage (1);

sub pod_text {
    require Pod::Text::Color;
    my $m = $ENV{NO_COLOR} ? "Pod::Text" : "Pod::Text::Color";
    my $p = $m->new ();
    open my $fh, ">", \my $out;
    $p->parse_from_file ($0, $fh);
    close $fh;
    print $out;
    exit 0;
    } # pod_text

sub pod_nroff {
    first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();

    require Pod::Man;
    my $p = Pod::Man->new ();
    open my $fh, "|-", "nroff", "-man";
    $p->parse_from_file ($0, $fh);
    close $fh;
    exit 0;
    } # pod_nroff

$opt_v >= 7 and _dump ("Configuration", \%conf);

if (defined $opt_J) {
    if ($opt_J) {
	$conf{json_pretty}++;
	$conf{json}++;
	}
    else {
	$conf{json_pretty} = 0;
	}
    }
$conf{json} and $opt_J = $conf{json_pretty};

if (@ARGV == 0 and my $eh = $ENV{GEOIP_HOST}) {
    $eh =~ s{[\s\r\n]+\z}{};
    # No IPv6 support yet
    if ($eh =~ m{^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$} and
	$1 > 0 && $1 < 256 && $2 < 256 && $3 < 256 && $4 < 256) {
	# Simplistic IPv4
	push @ARGV => $eh;
	}
    elsif ($eh =~ m/^\w[-.\w]{0,252}\z/) { # Skip invalid clipboard content
	# https://en.wikipedia.org/wiki/Hostname#Syntax
	for (split m/\./ => $eh) {
	    m/^\w[-\w]{0,62}$/ or die "$eh is not a valid hostname or IPv4\n";
	    }
	push @ARGV => $eh;
	}
    }

my $dbh = do {
    my $dsn = $conf{dsn} =~ s{^b=(?=\w+:)}{}ir; # catch -DB=.. instead of --DB=
    my $help = $dsn =~ m/^dbi:(\w+):/i
	? "Did you forget to install DBD::$1?"
	: "Maybe the matching DBD for $dsn is not installed";
    eval {
	my %seen;
	my $fail = sub {
	    my $e = DBI->errstr or return;
	    !$seen{$e}++ and warn "$e\n";
	    };
	local $SIG{__WARN__} = $fail;
	local $SIG{__DIE__}  = $fail;
	DBI->connect ($conf{dsn}, undef, undef, {
	    AutoCommit		=> 0,
	    RaiseError		=> 1,
	    PrintError		=> 1,
	    ShowErrorStatement	=> 1,
	    });
	} or die "Cannot continue without a working database\n$help\n";
    };

sub _dump {
    my ($label, $ref) = @_;
    print STDERR $use_data_peek
	? Data::Peek::DDumper ({ $label => $ref })
	: Data::Dumper->Dump ([$ref], [$label]);
    } # _dump

# Based on GeoIP2 CSV databases
#  City:   http://geolite.maxmind.com/download/geoip/database/GeoLite2-City-CSV.zip
#  Country http://geolite.maxmind.com/download/geoip/database/GeoLite2-Country-CSV.zip
#  ASN     http://geolite.maxmind.com/download/geoip/database/GeoLite2-ASN-CSV.zip

my $idx_type = $conf{dsn} =~ m/:Pg/     ? "using btree" : "";
my $truncate = $conf{dsn} =~ m/:SQLite/ ? "delete from" : "truncate table";

unless (grep m/\b country \b/ix => $dbh->tables (undef, undef, undef, undef)) {
    say "Create table stamps";
    $dbh->do (qq; create table stamps (
	name		text		not null	primary key,
	stamp		bigint);
	);
    say "Create table continent";
    $dbh->do (qq; create table continent (
	id		char (4)	not null	primary key,
	name		text);
	);
    say "Create table country";
    $dbh->do (qq; create table country (
	id		bigint		not null	primary key,
	name		text		not null,
	iso		text,
	continent	char (4),
	eu		smallint);
	);
    say "Create table ipv4"; # Country based
    $dbh->do (qq; create table ipv4 (
	cidr		cidr		not null	primary key,
	id		bigint,
	ip_from		text		not null,
	ip_to		text		not null,
	ip_from_n	bigint		not null,
	ip_to_n		bigint		not null,
	reg_country_id	bigint,
	rep_country_id	bigint,
	anon_proxy	smallint,
	satellite	smallint);
	);
    $dbh->do (qq; create index i_ipv4_ip on ipv4 $idx_type (ip_from_n, ip_to_n););
    say "Create table provider";
    $dbh->do (qq; create table provider (
	cidr		cidr		not null	primary key,
	id		bigint,
	name		text,
	ip_from		text,
	ip_to		text,
	ip_from_n	bigint,
	ip_to_n		bigint);
	);
    $dbh->do (qq; create index i_provider_ip on provider $idx_type (ip_from_n, ip_to_n););
    say "Create table city";
    $dbh->do (qq; create table city (
	id		bigint		not null	primary key,
	name		text,
	country_id	bigint,
	metro_code	text,
	tz		text,
	eu		smallint);
	);
    say "Create table ipc4"; # City based
    $dbh->do (qq; create table ipc4 (
	cidr		cidr		not null	primary key,
	id		bigint,
	ip_from		text		not null,
	ip_to		text		not null,
	ip_from_n	bigint		not null,
	ip_to_n		bigint		not null,
	reg_country_id	bigint,
	rep_country_id	bigint,
	anon_proxy	smallint,
	satellite	smallint,
	postal_code	text,
	latitude	text,
	longitude	text,
	accuracy	text );
	);
    $dbh->do (qq; create index i_ipc4_ip on ipv4 $idx_type (ip_from_n, ip_to_n););
    $dbh->commit;

    # grant connect on database geoip             to other_user;
    # grant select on all tables in schema public to other_user;
    }

my %cont; # Continents

my %stmp;
{   my $sth = $dbh->prepare ("select name, stamp from stamps");
    $sth->execute;
    while (my @s = $sth->fetchrow_array) {
	$stmp{$s[0]} = $s[1];
	}
    }

sub dtsz {
    my $f = shift;
    -f $f or return "-";
    my @s = stat $f;
    my @d = localtime $s[9];
    sprintf "%4d-%02d-%02d %02d:%02d:%02d %9d",
	$d[5] + 1900, ++$d[4], @d[3,2,1,0], $s[7];
    } # dtsz

if ($conf{fetch}) {
    my $key = $conf{license_key} or die "No license key in config file\n";
    my $base = "https://download.maxmind.com/app/geoip_download?edition_id=";
    foreach my $db (qw(	GeoLite2-ASN-CSV
			GeoLite2-Country-CSV
			GeoLite2-City-CSV
			)) {
	my $f = "$db.zip";
	printf STDERR     "%34s %s\n",     dtsz ($f), $f;
	my $url = join "&" => "$base$db", "license_key=$key", "suffix=zip";
	$opt_v > 5 and warn "Fetching $url ...\n";
	my $c = mirror ($url, $f);
	printf STDERR "%4d %29s %s\n", $c, dtsz ($f), $f;
	}
    }

my $zcfn = "GeoLite2-Country-CSV.zip";
if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) {
    my $zip = Archive::Zip->new;
    $zip->read ($zcfn)		and die "Cannot unzip $zcfn\n";
    my @cmn = $zip->memberNames	or  die "$zcfn hasd no members\n";

    say "Reading Country       info ...";
    my %ctry;
    $dbh->do ("$truncate continent");
    foreach my $cnm (grep m{\bGeoLite2-Country-Locations-en.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# geoname_id,locale_code,continent_code,continent_name,country_iso_code,country_name,is_in_european_union
	# 49518,en,AF,Africa,RW,Rwanda,0
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    $cont{$_{continent_code}} ||= $_{continent_name};
	    my $id = $_{geoname_id} or return;
	    my $ctry = {
		id		=> $id,
		name		=> $_{country_name},
		iso		=> $_{country_iso_code},
		continent	=> $_{continent_code},
		eu		=> $_{is_in_european_union},
		};
	    $ctry{$id} //= $ctry;
	    #$ctry{$_{country_iso_code}} //= $ctry;
	    });
	}
    {	$dbh->do ("$truncate continent");
	$dbh->commit;
	my $sti = $dbh->prepare ("insert into continent values (?, ?)");
	$sti->execute ($_, $cont{$_}) for keys %cont;
	$sti->finish;
	$dbh->commit;
	}
    {	$dbh->do ("$truncate country");
	$dbh->commit;
	my $sti = $dbh->prepare ("insert into country values (?, ?, ?, ?, ?)");
	$sti->execute (@{$_}{qw( id name iso continent eu )}) for values %ctry;
	$sti->finish;
	$dbh->commit;
	}

    say "Reading Country  IPv4 info ...";
    foreach my $cnm (grep m{\bGeoLite2-Country-Blocks-IPv4.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# network,geoname_id,registered_country_geoname_id,represented_country_geoname_id,is_anonymous_proxy,is_satellite_provider
	# 1.0.0.0/24,2077456,2077456,,0,0
	$dbh->do ("$truncate ipv4");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into ipv4 values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)");
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    ++$n % 1000 or print STDERR " $n\r";
	    my $cidr = $_{network};
	    my @rng = Net::CIDR::cidr2range ($cidr);
	    my ($f, $t) = split m/\s*-\s*/ => $rng[0];
	    my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t;
	    my $rec = {
		cidr		=> $cidr,
		id		=> $_{geoname_id} || undef,
		ip_from		=> $f,
		ip_to		=> $t,
		ip_from_n	=> $F,
		ip_to_n		=> $T,
		reg_country_id	=> $_{registered_country_geoname_id}  || undef,
		rep_country_id	=> $_{represented_country_geoname_id} || undef,
		anon_proxy	=> $_{is_anonymous_proxy},
		satellite	=> $_{is_satellite_provider},
		};
	    $sti->execute (@{$rec}{qw( cidr id ip_from ip_to ip_from_n ip_to_n
		reg_country_id rep_country_id anon_proxy satellite )});
	    });
	$sti->finish;
	$dbh->commit;
	}
    my $t = (stat $zcfn)[9];
    if ($stmp{$zcfn}) {
	$dbh->do ("update stamps set stamp = $t where name = '$zcfn'");
	}
    else {
	$dbh->do ("insert into stamps values ('$zcfn', $t)");
	}
    $dbh->commit;
    }
else {
    my $sth = $dbh->prepare ("select * from continent");
    $sth->execute;
    while (my $r = $sth->fetch) {
	$cont{$r->[0]} = $r->[1];
	}
    }

$zcfn = "GeoLite2-ASN-CSV.zip";
if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) {
    my $zip = Archive::Zip->new;
    $zip->read ($zcfn)		and die "Cannot unzip $zcfn\n";
    my @cmn = $zip->memberNames	or  die "$zcfn hasd no members\n";

    say "Reading Provider IPv4 info ...";
    foreach my $cnm (grep m{\bGeoLite2-ASN-Blocks-IPv4.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# network,autonomous_system_number,autonomous_system_organization
	# 1.0.0.0/24,13335,"Cloudflare, Inc."
	$dbh->do ("$truncate provider");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into provider values (?, ?, ?, ?, ?, ?, ?)");
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    ++$n % 1000 or print STDERR " $n\r";
	    my $cidr = $_{network};
	    my @rng = Net::CIDR::cidr2range ($cidr);
	    my ($f, $t) = split m/\s*-\s*/ => $rng[0];
	    my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t;
	    my $rec = {
		cidr		=> $cidr,
		id		=> $_{autonomous_system_number} || undef, # All NULL
		name		=> $_{autonomous_system_organization},
		ip_from		=> $f,
		ip_to		=> $t,
		ip_from_n	=> $F,
		ip_to_n		=> $T,
		};
	    $sti->execute (@{$rec}{qw( cidr id name ip_from ip_to ip_from_n ip_to_n )});
	    });
	$sti->finish;
	$dbh->commit;
	}
    my $t = (stat $zcfn)[9];
    if ($stmp{$zcfn}) {
	$dbh->do ("update stamps set stamp = $t where name = '$zcfn'");
	}
    else {
	$dbh->do ("insert into stamps values ('$zcfn', $t)");
	}
    $dbh->commit;
    }

$zcfn = "GeoLite2-City-CSV.zip";
if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) {
    my $zip = Archive::Zip->new;
    $zip->read ($zcfn)		and die "Cannot unzip $zcfn\n";
    my @cmn = $zip->memberNames	or  die "$zcfn hasd no members\n";

    say "Reading City          info ...";
    my (%country, %city);
    {	my $sth = $dbh->prepare ("select id, name from country");
	$sth->execute;
	while (my $r = $sth->fetch) { $country{$r->[1]} = $r->[0] }
	}
    foreach my $cnm (grep m{\bGeoLite2-City-Locations-en.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# geoname_id,locale_code,continent_code,continent_name,country_iso_code,
	#   country_name,subdivision_1_iso_code,subdivision_1_name,
	#   subdivision_2_iso_code,subdivision_2_name,city_name,metro_code,
	#   time_zone,is_in_european_union
	# 5819,en,EU,Europe,CY,Cyprus,02,Limassol,,,Souni,,Asia/Nicosia,1
	$dbh->do ("$truncate city");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into city values (?, ?, ?, ?, ?, ?)");
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    ++$n % 1000 or print STDERR " $n\r";
	    my $rec = {
		id		=> $_{geoname_id},
		name		=> $_{city_name},
		country_id	=> $country{$_{country_name}},
		metro_code	=> $_{metro_code},
		tz		=> $_{time_zone},
		eu		=> $_{is_in_european_union},
		};
	    # Subdivisions to store?
	    $sti->execute (@{$rec}{qw( id name country_id metro_code tz eu )});
	    });
	$sti->finish;
	$dbh->commit;
	}
    say "Reading City     IPv4 info ...";
    foreach my $cnm (grep m{\bGeoLite2-City-Blocks-IPv4.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# network,geoname_id,registered_country_geoname_id,
	#   represented_country_geoname_id,is_anonymous_proxy,
	#   is_satellite_provider,postal_code,latitude,longitude,accuracy_radius
	# 1.0.0.0/24,2062391,2077456,,0,0,5412,-34.1551,138.7482,1000
	$dbh->do ("$truncate ipc4");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into ipc4 values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)");
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    ++$n % 1000 or print STDERR " $n\r";
	    my $cidr = $_{network};
	    my @rng = Net::CIDR::cidr2range ($cidr);
	    my ($f, $t) = split m/\s*-\s*/ => $rng[0];
	    my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t;
	    my $rec = {
		cidr		=> $cidr,
		id		=> $_{geoname_id} || undef,
		ip_from		=> $f,
		ip_to		=> $t,
		ip_from_n	=> $F,
		ip_to_n		=> $T,
		reg_country_id	=> $_{registered_country_geoname_id}  || undef,
		rep_country_id	=> $_{represented_country_geoname_id} || undef,
		anon_proxy	=> $_{is_anonymous_proxy},
		satellite	=> $_{is_satellite_provider},
		postal_code	=> $_{postal_code},
		latitude	=> $_{latitude},
		longitude	=> $_{longitude},
		accuracy	=> $_{accuracy_radius},
		};
	    $sti->execute (@{$rec}{qw( cidr id ip_from ip_to ip_from_n ip_to_n
		reg_country_id rep_country_id anon_proxy satellite postal_code
		latitude longitude accuracy )});
	    });
	$sti->finish;
	$dbh->commit;
	}
    my $t = (stat $zcfn)[9];
    if ($stmp{$zcfn}) {
	$dbh->do ("update stamps set stamp = $t where name = '$zcfn'");
	}
    else {
	$dbh->do ("insert into stamps values ('$zcfn', $t)");
	}
    $dbh->commit;
    }

binmode STDERR, ":encoding(utf-8)";
binmode STDOUT, ":encoding(utf-8)";

if ($query_c) {
    @ARGV = ();
    my %ctry;
    my $sth = $dbh->prepare ("select id, name, continent from country");
    $sth->execute;
    $sth->bind_columns (\my ($id, $name, $cont));
    while ($sth->fetch) {
	$name =~ m/^ $query_c $/ix and $ctry{full}{$id} = [ $name, $cont, 0, 0 ];
	$name =~ m/  $query_c  /ix and $ctry{part}{$id} = [ $name, $cont, 0, 0 ];
	}
    $sth->finish;
    if    (keys %{$ctry{full}}) {
	%ctry = %{$ctry{full}};
	}
    elsif (keys %{$ctry{part}}) {
	%ctry = %{$ctry{part}};
	}
    else {
	$dbh->rollback;
	die "No matching country found for $query_c\n";
	}

    $sth = $dbh->prepare (join " " =>
	"select   cidr, reg_country_id, ip_from_n, ip_to_n",
	"from     ipv4",
	"order by reg_country_id, cidr");
    $sth->execute;
    $sth->bind_columns (\my $cidr, \$id, \my $from, \my $to);
    while ($sth->fetch) {
	defined $id or next;
	my $c = $ctry{$id} or next;
	say $cidr;
	$c->[2]++;
	$c->[3] += $to - $from + 1;
	}
    $sth->finish;
    $dbh->rollback;

    if ($opt_v) {
	my @w = (6, 10, 40, 15);
	printf STDERR "%s\n%$w[0]s %$w[1]s %-$w[2]s %s\n%s %s %s %s\n",
	    "Selected CIDR's", "# CIDR", "# IP", "Country", "Continent",
	    map { "-" x $_ } @w;
	printf STDERR "%$w[0]d %$w[1]d %-$w[2].$w[2]s %s\n",
	    @{$_}[2, 3, 0], $cont{$_->[1]} for
		sort { $a->[0] cmp $b->[0] } values %ctry;
	}

    exit 0;
    }

my %seen;
my %found;
while (@ARGV) {
    my $ip = shift or next;

    my $host;
    if ($ip =~ m/^\d{1,3}(?:\.\d{1,3}){3}$/ and my $n = inet_aton ($ip)) {
	$seen{$ip}++;
	# We might not have DNS when working off-line
	$host = gethostbyaddr ($n, AF_INET) and $seen{$host}++;
	}
    else {
	my ($name, $aliases, $type, $len, @addr) = gethostbyname ($ip);
	unless (@addr) {
	    warn "Cannot get the IP for $ip\n";
	    next;
	    }
	$host = $name;
	$ip = inet_ntoa (shift @addr);
	$seen{$ip}++;
	$seen{$host}++;
	push @ARGV, grep { $_ && !$seen{$_}++ }
	    (map { inet_ntoa $_ } @addr),
	    split m/\s+/ => $aliases;
	}

    $found{$ip} and next;

    my $in = unpack "L>" => inet_aton ($ip);
    #say "Look up $ip ($in) ...";

    my $sth = $dbh->prepare ("select * from ipv4 where ip_from_n <= $in and ip_to_n >= $in");
    my $stc = $dbh->prepare ("select * from country where id = ?");
    my $stC = $dbh->prepare ("select * from city    where id = ?");
    my $prov = do {
	my $stp = $dbh->prepare ("select name from provider where ip_from_n <= $in and ip_to_n >= $in");
	$stp->execute;
	my @p; while (my $p = $stp->fetch) { push @p, $p->[0]; }
	join " \x{2227} " => @p;
	};
    my $st4 = $dbh->prepare ("select * from ipc4 where ip_from_n <= $in and ip_to_n >= $in");
    $sth->execute;
    while (my $i = $sth->fetchrow_hashref) {
	$i->{provider} = $prov;
	$i->{ip}       = $ip;
	$i->{ip_n}     = $in;
	$i->{hostname} = $host // "(hostname not found)";
	foreach my $tp ("reg", "rep") {
	    if (my $cid = delete $i->{"${tp}_country_id"}) {
		$stc->execute ($cid);
		my $c = $stc->fetchrow_hashref or next;
		$i->{"${tp}_ctry_$_"} = $c->{$_} for keys %$c;
		delete $i->{"${tp}_ctry_id"};
		}
	    else {
		$i->{"${tp}_ctry_$_"} = "" for qw( iso name continent );
		}
	    $i->{"${tp}_continent"} = $cont{delete $i->{"${tp}_ctry_continent"}} || "";
	    }
	$st4->execute;
	if (my $c = $st4->fetchrow_hashref) {
	    $stc->execute (delete $c->{reg_country_id});
	    if (my $ctry = $stc->fetchrow_hashref) {
		$c->{country} = $ctry->{name};
		}
	    $i->{$_} = $c->{$_} for qw( postal_code latitude longitude accuracy );
	    $stC->execute (delete $c->{id});
	    if (my $city = $stC->fetchrow_hashref) {
		$i->{"city_$_"} = $city->{$_} for qw( name tz metro_code );
		}
	    $stC->finish;
	    }
	$st4->finish;
	$found{$ip} //= $i;
	}
    $stc->finish;
    }

my $here;
if (($conf{local_location} // "") =~ m{^(-?\d+\.\d+)\s*[,/]\s*(-?\d+\.\d+)\s*$}) {
    $here = { Latitude => $1, Longitude => $2 };
    }
elsif ($conf{distance} and eval { require LWP::UserAgent; require HTML::TreeBuilder; }) {
    my $ua = LWP::UserAgent->new (
	max_redirect => 2,
	agent        => "geoip/$VERSION",
	parse_head   => 0,
	timeout      => 10,
	cookie_jar   => {},
	);
    $ua->env_proxy;
    warn "Using GeoIP to determine own location\n";
    $here = {};
    my %cls = (
	lat	=> "Latitude",
	lng	=> "Longitude",
	ip	=> "IP",
	city	=> "City",
	company	=> "Provider",
	);
    foreach my $url (qw( https://iplocation.com https://geoiptool.com )) {
	my $rsp = $ua->request (HTTP::Request->new (GET => $url));
	if ($rsp->is_success) {
	    $opt_v > 1 and warn "$url: OK\n";
	    my $tree = HTML::TreeBuilder->new ();
	    if ($tree->parse_content ($rsp->content)) {
		foreach my $e ($tree->look_down (_tag => "div", class => "data-item")) {
		    my $di = $e->as_text or next;
		    $di =~ m/^\s*(\S[^:]+?)\s*:\s*(.*?)\s*$/ and $here->{$1} //= $2;
		    }
		foreach my $e ($tree->look_down (_tag => "td",
				class => qr{^(?:lat|lng|ip|city|company)$})) {
		    my $di = $e->as_text =~ s/^\s+//r =~ s/\s+$//r or next;
		    my $cl = $cls{$e->attr ("class")} or next;
		    $here->{$cl} //= $di;
		    }
		}
	    }
	elsif ($opt_v) {
	    printf STDERR "%-25s : %s\n", $url, $rsp->status_line;
	    }
	defined $here->{Longitude} and last;
	}
    unless (exists $here->{Longitude}) {
	# If I did not get info, use the database:
	# 1: dig -4 a +short myip.opendns.com @resolver1.opendns.com
	# 2: https://tools.tracemyip.org - only returns IP, no coordinates
	#    <div class="tsTxt14 txtBld"><span class="txtBld tsTxt14 sModPrW"><a href="/lookup/1.2.3.4">1.2.3.4</a></span></div>
	}
    defined $here->{Longitude} or $here = undef;
    $opt_v > 4 and _dump ("Here", $here);
    }

my @json;
for (sort { $a->{ip_from_n} <=> $b->{ip_to_n} ||
	    $a->{ip_n}      <=> $b->{ip_n}
	  } values %found) {
    $opt_v > 6 and _dump ("Processing", $_);
    my ($lat, $lon, $acc) = ($_->{latitude}, $_->{longitude}, $_->{accuracy});
    $_->{city} = join ", " => grep m/\S/ => map { $_ || "" }
	$_->{city_name}, $_->{city_metro_code}, $_->{postal_code};
    $_->{city_tz} ||= "";
    my %json = %$_;

    unless ($conf{json}) {
	say "GeoIP data for $_->{ip} - $_->{hostname}:";
	say "   CIDR      : $_->{cidr}";
	say "   IP range  : $_->{ip_from} - $_->{ip_to}";
	say "   Provider  : $_->{provider}";
	say "   City      : $_->{city}";
	say "   Country   : $_->{reg_ctry_iso}  $_->{reg_ctry_name}";
	say "   Continent : $_->{reg_continent}";
	say "   Timezone  : $_->{city_tz}";
	}

    if (!$conf{short} && ($lat || $lon)) {
	my ($lat_dms, $lon_dms) = map { dec2dms ($_) } $lat, $lon;
	@json{qw( latitude_dms longitude_dms )} = ($lat_dms, $lon_dms);
	$conf{json} or printf "   Location  : %9.4f / %9.4f %-6s %14s / %14s\n",
	    $lat, $lon, "($acc)", $lat_dms, $lon_dms;
	# OSM max zoom = 19, Google Maps max zoom = 21
	my $z = 16 - int log $acc;
	my @map = (
	    "https://www.openstreetmap.org/#map=$z/$lat/$lon",
	    "https://www.google.com/maps/place/\@$lat,$lon,${z}z",
	    );
	$json{map_urls} = \@map;
	$conf{json} or say "               $_" for @map;

	if ($here) {
	    my ($llat, $llon) = ($here->{Latitude}, $here->{Longitude});
	    my ($llat_dms, $llon_dms) = map { dec2dms ($_) } $llat, $llon;
	    my ($dist, $unit) = (distance ($lat, $lon, $llat, $llon), "km");
	    ($conf{distance} || "km") eq "miles" and
		($dist, $unit) = ($dist * 0.62137119, "mile");
	    @json{qw( local_latitude local_longitude
		      local_latidue_dms local_longitude_dms
		      distance distance_unit )} =
		($llat, $llon, $llat_dms, $llon_dms, $dist, $unit);
	    $conf{json} or printf "   Location  : %9.4f / %9.4f %-6s %14s / %14s\n",
		$llat, $llon, "", $llat_dms, $llon_dms;
	    $conf{json} or printf "   Distance  : \x{00b1} %.2f%s\n", $dist, $unit;
	    }
	}
    if ($conf{whois} && $whois and my $wi = $whois->($_->{ip})) {
	my $address = join " " => grep { length } map { $wi->{$_} } qw(
	    Address PostalCode StateProv Country address );
	my %w = (
	    ID      => $wi->{OrgId}         || $wi->{"admin-c"},
	    Name    => $wi->{OrgNOCName}    || $wi->{OrgName}      || $wi->{descr},
	    Phone   => $wi->{OrgNOCPhone}   || $wi->{OrgTechPhone} || $wi->{phone},
	    EMail   => $wi->{OrgTechEmail}  || $wi->{OrgNOCEmail}  || $wi->{"e-mail"},
	    Abuse   => $wi->{OrgAbuseEmail} || $wi->{"abuse-mailbox"},
	    Address => $address,
	    );

	$opt_v > 8 and _dump ("WhoIs", { wi => $wi, w => \%w });
	my @wi = map { sprintf "     %-7s : %s", $_, $w{$_} }
	         grep { length $w{$_} } qw( Name ID Phone EMail Abuse Address );
	$json{whois} = \%w;
	!$conf{json} && @wi and say for "   Whois information:", @wi;
	}
    if ($conf{json}) {
	push @json, \%json;
	}
    elsif (!$conf{short}) {
	say "   EU member : ", $_->{reg_ctry_eu} ? "Yes" : "No";
	say "   Satellite : ", $_->{satellite}   ? "Yes" : "No";
	say "   Anon Proxy: ", $_->{anon_proxy}  ? "Yes" : "No";
	}
    }

$dbh->rollback;
$dbh->disconnect;

if ($conf{json}) {
    say $opt_J
	? JSON::PP->new->pretty->allow_nonref->encode (\@json)
	: JSON::PP->new->ascii ->allow_nonref->encode (\@json);
    }

sub dec2dms {
    my $dec = shift or return "";

    my $deg = int $dec;
    my $dm  = abs ($dec - $deg) * 60;
    my $min = int $dm;
    my $sec = ($dm - $min) * 60;
    sprintf "%d\x{00b0}%02d'%05.2f\"", $deg, $min, $sec;
    } # dec2dms

sub distance {
    my ($lat_c, $lon_c, $lat_s, $lon_s) = @_;

    $gis and
	return $gis->distance ($lat_c, $lon_c, $lat_s, $lon_s)->meters / 1000.;

    my $rad = 6371; # km

    # Convert angles from degrees to radians
    my $dlat = deg2rad ($lat_s - $lat_c);
    my $dlon = deg2rad ($lon_s - $lon_c);

    my $x = sin ($dlat / 2) * sin ($dlat / 2) +
	    cos (deg2rad ($lat_c)) * cos (deg2rad ($lat_s)) *
		sin ($dlon / 2) * sin ($dlon / 2);

    return $rad * 2 * atan2 (sqrt ($x), sqrt (1 - $x)); # km
    } # distance

sub getconf {
    my $home = $ENV{HOME} || $ENV{USERPROFILE} || $ENV{HOMEPATH};
    foreach my $rcf (grep { -s }
            "$home/geoip.rc", "$home/.geoiprc", "$home/.config/geoip") {
        my $mode = (stat $rcf)[2];
        $mode & 022 and next;
        open my $fh, "<", $rcf or next;
        while (<$fh>) {
            m/^\s*[;#]/ and next;
            my ($k, $v) = (m/^\s*([-\w]+)\s*[:=]\s*(.*\S)/) or next;
            $conf{ lc $k
                =~ s{-}{_}gr
                =~ s{^use_}{}ir
                =~ s{^(json_)?(?:unicode|utf-?8?)$}{utf8}ir
                =~ s{^dist$}{distance}ir
              } = $v
                =~ s{(?:U\+?|\\[Uu])([0-9A-Fa-f]{2,7})}{chr hex $1}ger
                =~ s{^(?:no|false)$}{0}ir
                =~ s{^(?:yes|true)$}{1}ir;
            }
	}
    } # getconf

1;

__END__

=encoding utf-8

=head1 NAME

geoip - a tool to show geographical data based on hostname or IP address(es)

=head1 SYNOPSIS

 geoip --help

 geoip --fetch [--no-update]

 geoip [options] [host|IP ...]

=head1 DESCRIPTION

This tool uses a database to use the (pre-fetched) GeoIP2 data from MaxMind
to show related geographical information for IP addresses. This information
can optionally be extended with information from online WHOIS services and
or derived data, like distance to the location of the server this tool runs
on or a configured local location.

The output is plain text or JSON. JSON may be short or formatted.

=head2 Configuration

The tool allows the use of configuration files. It tests for existence of
the files listed here. All existing files is read (in this order) if it is
only writable by the author (mode C<0640> should do).

   $home/geoip.rc
   $home/.geoiprc
   $home/.config/geoip

where C<$home> is either of C<$HOME>, C<$USERPROFILE>, or C<$HOMEPATH>.

The format of the file is

  # Comment
  ; Comment
  option : value
  option = value

where the C<:> and C<=> are equal and whitespace around them is optional
and ignored. The values C<False> and C<No> (case insensitive) are the same
as C<0> and the values C<True> and C<Yes> are equal to C<1>. For readability
you can prefix C<use_> to most options (it is ignored). The use of C<-> in
option names is allowed and will be translated to C<_>.

The recognized options and the command line equivalences are

=over 2

=item fetch

command line option : C<-f> or C<--fetch>

default value       : False

Fetch new databases from the MaxMind site.

=item update

command line option : C<-u> or C<--update>

default value       : True

Only in effect when used with C<--fetch>: when new data files from MaxMind
have successfully been fetched and any of these is newer that what the
database contains, update the database with the new data.

=item distance

command line option : C<-d> or C<--distance>

default value       : False

If both the location of the tool I<and> the location of the requested IP
are known, calculate the distance between them. The default is to show
the distance in kilometers. Choosing a configuration of C<miles> instead
of C<True>, C<Yes>, or C<1> will show the distance in miles. There is no
command line option for miles.

The location of the tool is either locally stored in your configuration
(see C<--local-location>) or fetched using the result of the urls
L<C<iplocation.com>|https://iplocation.com> or
L<C<geoiptool>|https://geoiptool.com>. This will - of course - not work
if there is no network connection or outside traffic is not allowed.

=item whois

command line option : C<-w> or C<--whois>

default value       : False

If L<Net::Whois::IP> is installed, and this option is true, this module
will be used to retrieve the C<whois> information. This will not work if
there is no network connection or outside traffic is not allowed.

=item short

command line option : C<-s> or C<--short>

default value       : False

This option will disable the output of less-informative information like
location, EU-membership, satellite and proxy. This option, if True, will
also implicitly disable the C<distance> and C<whois> information.

=item dsn

command line option : C<-Ddsn> or C<--DB=dsn>

default value       : C<$ENV{EOIP_DBI_DSN}> or C<dbi:Pg:geoip>

See L</DATABASE> for the (documented) list of supported database types.

If the connection works, the tables used by this tool will be created if
not yet present.

The order of usage is:

=over 2

=item 1

Command line argument (C<--DB=dsn>)

=item 2

The C<GEOIP_DBI_DSN> environment variable

=item 3

The value for C<dsn> in the configuration file(s)

=item 4

C<dbi:Pg:dbname=geoip>

=back

=item json

command line option : C<-j> or C<--json>

default value       : False

The default output for the information is plain text. With this option,
the output will be in JSON format. The default is not prettified.

=item json-pretty

command line option : C<-J> or C<--json-pretty>

default value       : False

If set from the command-line, this implies the C<--json> option.

With this option, JSON output is done I<pretty> (indented).

=item local-location

command line option : C<-l lat/lon> or C<--local=lat/lon>

default value       : Undefined

Sets the local location coordinates for use with distances.

When running the tool from a different location than where the IP access is
to be analyzed for or when the network connection will not report a location
that would make sense (like working from a cloud or running over one or more
VPN connections), one can set the location of the base in decimal notation.
(degree-minute-second-notation is not yet supported).

This is also useful when there is no outbound connection possible or when you
do not move location and you want to restrict network requests.

The notation is decimal (with a C<.>, no localization support) where latitude
and longitude are separated by a C</> or a C<,>, like C<-l 12.345678/-9.876543>
or C<--local=12,3456,45,6789>.

=item maxmind-account

command line option : none

default value       : Undefined

Currently not (yet) used. Documentation only.

=item license-id

command line option : none

default value       : Undefined

Currently not (yet) used. Documentation only.

=item license-key

command line option : none

default value       : Undefined

As downloads are only allowed/possible using a valid MaxMind account, you need
to provide a valid license key in your configuration file. If you do not have
an account, you can sign up L<here|https://www.maxmind.com/en/geolite2/signup>.

=back

=head1 DATABASE

Currently PostgreSQL and SQLite have been tested, but others may (or may not)
work just as well. YMMV. Note that the database need to know the C<CIDR>
field type and is able to put a primary key on it.

MariaDB and MySQL are not supported, as they do not support the concept of
CIDR type fields.

The advantage of PostgreSQL over SQLite is that you can use it with multiple
users at the same time, and that you can share the database with other hosts
on the same network behind a firewall.

The advantage of SQLite over PostgreSQL is that it is a single file that you
can copy or move to your liking. This file will be somewhere around 500 Mb.

=head1 EXAMPLES

=head2 Configuration

 $ cat ~/.config/geoip
 use_distance    : True
 json-pretty     : yes

=head2 Basic use

 $ geoip --short 1.2.3.4

=head2 For automation

 $ geoip --json --no-json-pretty 1.2.3.4

 $ env GEOIP_HOST=1.2.3.4 geoip

=head2 Full report

 $ geoip --dist --whois 1.2.3.4

=head2 Selecting CIDR's for countries

=head3 List all CIDR's for Vatican City

 $ geoip --country=Vatican > vatican-city.cidr

=head3 Statistics

If you enable verbosity, the selected statistics will be presented at the
end of the CIDR-list: number of CIDR's, number of enclosed IP's, name of
the country and the continent. As the country name is just a perl regex,
you can select all countries with C<.>, or all countries that start with
a C<V>:

 $ geoip --country=^V -v >/dev/null
 Selected CIDR's
 # CIDR       # IP Country               Continent
 ------ ---------- --------------------- ---------------
     21      18176 Vanuatu               Oceania
    321      13056 Vatican City          Europe
    272    6798500 Venezuela             South America
    612   16014080 Vietnam               Asia

=head1 TODO

=over 2

=item IPv6

The ZIP files also contain IPv6 information, but it is not (yet) converted
to the database, nor supported in analysis.

=item Modularization

Split up the different parts of the script to modules: fetch, extract,
check, database, external tools, reporting.

=item CPAN

Turn this into something like App::geoip, complete with Makefile.PL

=back

=head1 SEE ALSO

L<DBI>, L<Net::CIDR>, L<Math::Trig>, L<LWP::Simple>, L<Archive::ZIP>,
L<Text::CSV_XS>, L<JSON::PP>, L<GIS::Distance>, L<Net::Whois::IP>,
L<HTML::TreeBuilder>, L<Data::Dumper>, L<Data::Peek>, L<Socket>

L<Geo::Coder::HostIP>, L<Geo::IP>, L<Geo::IP2Location>, L<Geo::IP2Proxy>,
L<Geo::IP6>, L<Geo::IPfree>, L<Geo::IP::RU::IpGeoBase>, L<IP::Country>,
L<IP::Country::DB_File>, L<IP::Country::DNSBL>, L<IP::Info>, L<IP::Location>,
L<IP::QQWry>, L<IP::World>, L<Metabrik::Lookup::Iplocation>, L<Pcore::GeoIP>

L<IP::Geolocation::MMDB>

Check L<CPAN|https://metacpan.org/search?q=geoip> for more.

=head1 THANKS

Thanks to cavac for the inspiration

=head1 AUTHOR

H.Merijn Brand F<E<lt>hmbrand@cpan.orgE<gt>>, aka Tux.

=head1 COPYRIGHT AND LICENSE

The GeoLite2 end-user license agreement, which incorporates components of the
Creative Commons Attribution-ShareAlike 4.0 International License 1) can be found
L<here|https://www.maxmind.com/en/geolite2/eula> 2). The attribution requirement
may be met by including the following in all advertising and documentation
mentioning features of or use of this database.

This tool uses, but does not include, the GeoLite2 data created by MaxMind,
available from [http://www.maxmind.com](http://www.maxmind.com).

 Copyright (C) 2018-2026 H.Merijn Brand.  All rights reserved.

This library is free software;  you can redistribute and/or modify it under
the same terms as Perl itself.
See L<here|https://opensource.org/licenses/Artistic-2.0> 3).

 1) https://creativecommons.org/licenses/by-sa/4.0/
 2) https://www.maxmind.com/en/geolite2/eula
 3) https://opensource.org/licenses/Artistic-2.0

=for elvis
:ex:se gw=75|color guide #ff0000:

=cut
