App-geoip
view release on metacpan or search on metacpan
lib/App/geoip.pm view on Meta::CPAN
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),
lib/App/geoip.pm view on Meta::CPAN
}
}
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 (
( run in 1.769 second using v1.01-cache-2.11-cpan-39bf76dae61 )