aboutsummaryrefslogtreecommitdiff
path: root/whoseip/whoseip.pl
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2014-10-08 14:15:36 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2014-10-08 17:32:29 +0300
commit78bdce8959df29f16cde8e7c891d91af2e008855 (patch)
treeface0c049e934a8a70ea5eb69b98750e6de6f05e /whoseip/whoseip.pl
parent2058b5fa7f286338fb5b7e9fa586fe4dfe0db31d (diff)
downloaddnstools-78bdce8959df29f16cde8e7c891d91af2e008855.tar.gz
dnstools-78bdce8959df29f16cde8e7c891d91af2e008855.tar.bz2
New utility: whoseip
Given an IPv4 address, whoseip determines the country where it is located and network it belongs to. It uses whois service for that.
Diffstat (limited to 'whoseip/whoseip.pl')
-rw-r--r--whoseip/whoseip.pl508
1 files changed, 508 insertions, 0 deletions
diff --git a/whoseip/whoseip.pl b/whoseip/whoseip.pl
new file mode 100644
index 0000000..4557aef
--- /dev/null
+++ b/whoseip/whoseip.pl
@@ -0,0 +1,508 @@
+#! /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 POSIX qw(strftime time floor);
+use IO::Socket;
+use Pod::Usage;
+use Pod::Man;
+use Time::ParseDate;
+use GDBM_File;
+use Socket qw(:DEFAULT :crlf);
+use Net::CIDR;
+
+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_CANTCREAT => 73; # can't create (user) output file
+
+my $progname; # This script name;
+($progname = $0) =~ s/.*\///;
+
+my $progdescr = "Whois service for IP addresses";
+my $debug;
+my $iplistfile;
+my $clonefile;
+my @ipv4list;
+
+my $ipv4rx = '\d{1,3}((\.\d{1,3}){3})';
+my $delim = $LF; # Output delimiter
+
+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_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 @a = split /-/, shift;
+ return 0 unless $#a == 1;
+ return str2ipv4($a[1]) - str2ipv4($a[0]);
+}
+
+# ############
+# ARIN
+# ############
+sub arin_fmt {
+ my $q = shift;
+ return "n + $q";
+}
+
+sub arin_decode {
+ my ($input, $ref) = @_;
+
+ return if ($input =~ /^#/ or $input eq '');
+
+ if ($input =~ /^NetRange:\s+(.+)/) {
+ my $r = $1;
+ $r =~ s/\s+//g;
+ my $n = range2count($r);
+ if (!defined($ref->{count}) or $ref->{count} > $n) {
+ $ref->{range} = $r;
+ $ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
+ $ref->{count} = $n;
+ delete $ref->{country}
+ }
+ } elsif ($input =~ /^Country:\s+(.+)/ and !defined($ref->{country})) {
+ $ref->{country} = $1;
+ }
+}
+
+# ############
+# RIPE
+# ############
+use constant RIPE_INIT => 0;
+use constant RIPE_TEXT => 1;
+use constant RIPE_IGNR => 2;
+
+sub ripe_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 $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 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} = join ',', Net::CIDR::cidr2range($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}) or $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} = join ',', Net::CIDR::cidr2range($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}) or $ref->{count} > $c) {
+ $ref->{count} = $c;
+ $ref->{range} = $r;
+ $ref->{cidr} = join ',', Net::CIDR::range2cidr($r);
+ $ref->{country} = 'KR';
+ }
+ }
+}
+
+# #######################################################################
+# Server table
+# #######################################################################
+
+my %srvtab = (
+ 'whois.arin.net' => { q => \&arin_fmt, d => \&arin_decode },
+ 'whois.lacnic.net' => { d => \&lacnic_decode },
+ 'whois.ripe.net' => { 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 },
+);
+
+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;
+ while (<$sock>) {
+ chomp;
+ 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;
+# while (my ($k,$v) = each %res) {
+# print "$k $v\n";
+# }
+ return %res;
+}
+
+sub serve {
+ my $term = shift;
+ my %res;
+
+ if ($term =~ /^${ipv4rx}$/) {
+ my $srv = findsrv($term);
+ if (defined($srv) and $srv ne 'UNKNOWN') {
+ while (%res = whois($term, $srv),
+ and defined($res{referto})) {
+ $srv = $res{referto};
+ }
+ if (!defined($res{country})) {
+ $res{status} = 'NO';
+ $res{diag} = 'IP unknown';
+ } else {
+ $res{status} = 'OK';
+ }
+ } else {
+ $res{status} = 'NO';
+ $res{diag} = 'whois server unknown';
+ }
+ } else {
+ $res{status} = 'BAD';
+ $res{diag} = 'invalid input';
+ }
+ $res{term} = $term;
+ return %res;
+}
+
+# #######################################################################
+# Output functions
+# #######################################################################
+
+sub default_output {
+ local %_ = @_;
+
+ print "$_{status} ";
+ if ($_{status} eq 'OK') {
+ print "$_{country} $_{cidr} $_{range} $_{count}";
+ } else {
+ print $_{diag};
+ }
+ print $delim;
+}
+
+sub xml_output {
+ local %_ = @_;
+ while (my ($k,$v) = each %_) {
+ next if $k eq 'state';
+ print " <whoseip:$k>$v</whoseip:$k>\n";
+ }
+ print "</whoseip>\n";
+}
+
+# #######################################################################
+# Main
+# #######################################################################
+
+GetOptions("h" => sub {
+ pod2usage(-message => "$progname: $progdescr",
+ -exitstatus => 0);
+ },
+ "help" => sub {
+ pod2usage(-exitstatus => EX_OK, -verbose => 2);
+ },
+ "usage" => sub {
+ pod2usage(-exitstatus => EX_OK, -verbose => 0);
+ },
+ "debug|d+" => \$debug,
+ "file|f=s" => \$iplistfile,
+ "clone|o=s" => \$clonefile
+) or exit(EX_USAGE);
+
+read_ipv4list($iplistfile) if defined($iplistfile);
+
+if (defined($clonefile)) {
+ open(my $ifd, "<", $0)
+ or abend(EX_NOINPUT, "can't open $0 for reading");
+ open(my $ofd, ">", $clonefile)
+ or abend(EX_CANTCREAT, "can't open $clonefile for writing");
+ while (<$ifd>) {
+ if (/^my \@ipv4list;/) {
+ 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;
+}
+
+my $output = \&default_output;
+
+my $term;
+my %res;
+if ($ENV{GATEWAY_INTERFACE} =~ m#CGI/\d+\.\d+#) {
+ $output = \&xml_output;
+ if ($ENV{QUERY_STRING} =~ /^$ipv4rx$/) {
+ $term = $ENV{QUERY_STRING};
+ } else {
+ my @res = grep(/^ip=$ipv4rx$/, split(/\&/, $ENV{QUERY_STRING}));
+ if ($#res == 0) {
+ $term = $res[0];
+ $term =~ s/ip=//;
+ }
+ }
+ print <<EOT;
+Content-Type: text/xml
+
+<?xml version="1.0" encoding="US-ASCII"?>
+<whoseip xmlns:whoseip="http://man.gnu.org.ua/8/whoseip">
+EOT
+;
+ if (defined($term)) {
+ %res = serve($term);
+ } else {
+ %res = (status => 'BAD', diag => 'search term invalid or missing');
+ }
+ &{$output}(%res);
+} elsif ($#ARGV == -1) {
+ my $term;
+ my %res;
+
+ unless (-t *STDIN) {
+ local $/ = CRLF;
+ $delim = "$CR$LF";
+ }
+ $term = <>;
+ chomp $term;
+ %res = serve($term);
+ &{$output}(%res);
+} else {
+ foreach my $term (@ARGV) {
+ &{$output}(serve($term));
+ }
+}

Return to:

Send suggestions and report system problems to the System administrator.