diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2014-10-08 14:15:36 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2014-10-08 17:32:29 +0300 |
commit | 78bdce8959df29f16cde8e7c891d91af2e008855 (patch) | |
tree | face0c049e934a8a70ea5eb69b98750e6de6f05e /whoseip/whoseip.pl | |
parent | 2058b5fa7f286338fb5b7e9fa586fe4dfe0db31d (diff) | |
download | dnstools-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.pl | 508 |
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)); + } +} |