--- Net-Whois-IP/IP.pm 2002/11/30 02:45:47 1.2 +++ Net-Whois-IP/IP.pm 2002/12/01 14:51:23 1.3 @@ -12,8 +12,6 @@ =cut -# http://www.irr.net/docs/rpsl.html - package Net::Whois::IP; BEGIN { @@ -47,6 +45,37 @@ or die "$_[0]: unable to create/open table"; } +sub ip_range { + my $range = $_[0]; + + if ($range =~ /^ + (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) + (?:\. + (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) + (?:\. + (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) + (?:\. + (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) + )? + )? + )? + \/ + ([0-9]+) + $/x) { + my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4; + my $net = 1 << (31 - $5); + my $mask = inet_aton 2 ** 32 - $net; + + my $ip1 = $ip & $mask; + my $ip2 = $ip1 | inet_aton $net * 2 - 1; + return unpack "N2", "$ip1$ip2"; + } elsif ($range =~ /^\s*([0-9.]+)\s*-\s*([0-9.]+)\s*$/) { + unpack "N*", (inet_aton $1) . (inet_aton $2); + } else { + die "$range: unable to parse ip range"; + } +} + package Net::Whois::IP::base; sub new { @@ -55,14 +84,21 @@ name => @_, }, $class; $self->{request} ||= new Coro::Channel $self->{request_backlog} || 10; - $self->{daemon} = Coro::async { shift->_daemon } $self; + $self->{daemon} = Coro::async { + while () { + eval { $self->_daemon }; + warn "restarting daemon for whois server $self->{name}: $@"; + } + }; + $self->{daemon}->prio(1); $self->{cache} = Net::Whois::IP::new_btree "whois_" . lc $self->{name}; $server{$self->{name}} = $self; } sub _failure { - my $self = shift; + my ($self, $min) = shift; undef $self->{fh}; + $self->{retry} = $min if $self->{retry} < $min; Coro::Timer::sleep 1.5 ** $self->{retry} - 2 if $self->{retry}; $self->{retry}++ if $self->{retry} < 17; } @@ -90,25 +126,52 @@ $self->{request}->put($request); $request->{ready}->down; + $request->{response} =~ s/\015//g; + $request->{response} =~ s/\012/\n/g if "\012" ne "\n"; + $response = time . "\x00" . $request->{response}; $self->{cache}->db_put($query, $response); - + $request->{response}; } sub ip_query { my ($self, $ip) = @_; - $self->_query($ip); + $self->sanitize_ip_response($self->_query($ip)); } -sub parse_ip_response { +sub sanitize_ip_response { my ($self, $response) = @_; - my %response; - while ($response =~ /^([^:]+):[ \t]*(.*)$/mg) { - push @{$response{$1}}, $2; + $response; +} + +sub parse_ip_response { + my ($self, $response, $tags, $res) = @_; + $res->{whois_server} = $self->{name}; + while ($response =~ /^([^:]+):[ \t]* + ( + .* + (?:\n[\t ].*)* + ) + /mgx) { + my ($tag, $val) = ($1, $2); + if (exists $tags->{$tag}) { + push @{$res->{$tags->{$tag}}}, $val if defined $tags->{$tag}; + } else { + use Carp; + confess "unknown tag $tag=$val"; + } } - \%response; + $res; +} + +# check wether the given response is a referral to another server +# find out which one, and the ip range we were referred +sub is_ip_referral { + my ($self, $response) = @_; + # ($iprange, $server) + (); } package Net::Whois::IP::whois; @@ -119,31 +182,78 @@ sub _daemon { my $self = shift; - while (my $request = $self->{request}->get) { + my $request; + while ($request = $self->{request}->get) { my $fh = new Coro::Socket PeerHost => $self->{server} or $self->_failure, redo; $fh->print("$request->{query}\012"); $fh->sysread($request->{response}, 16384); - length $request->{response} - or $self->_failure, redo; + + length $request->{response} or $self->_failure, redo; + $request->{response} =~ /^% query rate limit exceeded/im and $self->_failure(9), redo; $self->_ok; $request->{ready}->up; } } -sub ip_query { - my ($self, $ip) = @_; - $self->SUPER::ip_query($ip); +sub sanitize_ip_response { + my ($self, $response) = @_; + $response = "" if $response =~ /^% not assigned/im; + $response =~ s/^%.*//mg; + $response =~ s/[ \t]+$//mg; # brnic, maybe others + $response =~ s/^\n+//; + $response =~ s/\n\n.*//s; + $self->SUPER::sanitize_ip_response($response); } sub parse_ip_response { + my ($self, $response, $tags) = @_; + $self->SUPER::parse_ip_response($response, $tags || { + inetnum => "netblock", + netname => "netname", + descr => "description", + owner => "description", + address => "description", + phone => "description", + country => "country", + ownerid => "owner-c", + "admin-c" => "admin-c", + "tech-c" => "tech-c", + "owner-c" => "owner-c", + "abuse-c" => "abuse-c", + status => "status", + notify => "notify", + changed => "changed", + created => "created", + source => "source", + remarks => "remarks", + "mnt-by" => "mnt-by", + "mnt-irt" => "irt-c", # incident response team + "rev-srv" => "nameserver", + nserver => "nameserver", + "mnt-lower" => undef, + "mnt-routes"=> undef, + responsible => undef, + nsstat => undef, + nslastaa => undef, + "aut-num" => undef, + inetrev => undef, # nameserver-dependent + "inetnum-up" => undef, + }); +} + +sub is_ip_referral { my ($self, $response) = @_; - $response =~ s/^%.*//mg; - $response =~ s/^\012+//; - $response =~ s/\012\012.*//s; - $self->SUPER::parse_ip_response($response); + $response =~ /^inetnum:\s+(.*)/m + or return; + my $iprange = $1; + if ($response =~ /^remarks:\s+These addresses have been further assigned to Brazilian users./m) { + return ($iprange, $server{BRNIC}); + } + # ($iprange, $server) + (); } package Net::Whois::IP::jpnic; @@ -157,11 +267,30 @@ $self->SUPER::ip_query("$ip/e"); } -sub parse_ip_response { +sub sanitize_ip_response { my ($self, $response) = @_; $response =~ s/^\[\s.*//mg; - $response =~ s/^(?:\w\.\ )? \[ ([^\]]+) \] (.*) (?:\012(?=\s))?/$1: $2/mgx; - $self->SUPER::parse_ip_response($response); + $response =~ s/^(?:\w\.\ )? \[ ([^\]]+) \] (.*)/$1: $2/mgx; + $self->SUPER::sanitize_ip_response($response); +} + +sub parse_ip_response { + my ($self, $response) = @_; + $self->SUPER::parse_ip_response($response, { + "Network Information" => undef, + "Network Number" => "netblock", + "Network Name" => "netname", + "Organization" => "description", + "Administrative Contact" => "admin-c", + "Technical Contact" => "tech-c", + "Nameserver" => "nameserver", + "Reply Mail" => undef, + "Assigned Date" => "created", + "Return Date" => "expires", + "Last Update" => "changed", + }, { + country => "JP", + }); } package Net::Whois::IP::ripe; @@ -174,7 +303,8 @@ my $self = shift; my $fh; - while (my $request = $self->{request}->get) { + my $request; + while ($request = $self->{request}->get) { unless ($self->{fh}) { $fh = new Coro::Socket PeerHost => $self->{server}; $fh or $self->_failure, redo; @@ -190,9 +320,18 @@ } } +sub sanitize_ip_response { + my ($self, $response) = @_; + $response = "" if $response =~ /^netname:\s+IANA-BLK$/m; + $response = "" if $response =~ /This network range is not allocated to APNIC./; + # $response = "" if $response =~ /^remarks:\s+.*the IP has not been allocated by APNIC./m; + $self->SUPER::sanitize_ip_response($response); +} + package Net::Whois::IP::rwhois; -# rwhois 1.5 +# rwhois 1.5, of course, as usual arin's implementation is utterly broken +# and doesn't help very much use base Net::Whois::IP::base; @@ -202,7 +341,7 @@ $self->{fh}->print("$_[0]\015\012"); while (defined (my $line = $self->{fh}->readline)) { - $line =~ s/[\015\012]+$/\n/g; + $line =~ s/[\015\012]+$/\012/g; $response .= $line; $line =~ /^%(ok|error)/ and return $response; } @@ -211,7 +350,8 @@ sub _daemon { my $self = shift; - while (my $request = $self->{request}->get) { + my $request; + while ($request = $self->{request}->get) { unless ($self->{fh}) { $self->{fh} = new Coro::Socket PeerHost => $self->{server}; $self->{fh} or $self->_failure, redo; @@ -233,52 +373,89 @@ $self->SUPER::ip_query("network $ip"); } -sub parse_ip_response { +sub sanitize_ip_response { my ($self, $response) = @_; - $response =~ s/^([^:]+):([^:]+):/$1-\L$2: /mg; + $response =~ s/^% referral/REFERRAL:/mg; $response =~ s/^%.*//mg; - $response =~ s/\012\012.*//s; - $self->SUPER::parse_ip_response($response); + $response =~ s/\n\n.*//s; + $response = "" if $response =~ /^network:Org-Name:Various Registries \(Maintained by ARIN\)/m; + $response =~ s/^([^:]+):([^:]+):/$1-\L$2: /mg; + $response; } -package Net::Whois::IP; - -sub ip_range { - my $range = $_[0]; - - if ($range =~ /^ - (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) - (?:\. - (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) - (?:\. - (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) - (?:\. - (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) - )? - )? - )? - \/ - ([0-9]+) - $/x) { - my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4; - my $net = 1 << (31 - $5); - my $mask = inet_aton 2 ** 32 - $net; +sub parse_ip_response { + my ($self, $response) = @_; + $self->SUPER::parse_ip_response($response, { + "network-class-name" => undef, + "network-auth-area" => "auth-area", + "network-id" => "id", + "network-handle" => "handle", + "network-network-name" => "netname", + "network-ip-network" => undef, + "network-ip-network-block" => "netblock", + "network-org-name" => "description", + "network-street-address" => "address", + "network-city" => "address", + "network-state" => "address", + "network-postal-code" => "address", + "network-country-code" => "country", + "network-tech-contact;i" => "tech-c", + "network-admin-contact;i" => "admin-c", + "network-created" => "created", + "network-updated" => "changed", + }); +} - my $ip1 = $ip & $mask; - my $ip2 = $ip1 | inet_aton $net * 2 - 1; - return unpack "N2", "$ip1$ip2"; - } elsif ($range =~ /^\s*([0-9.]+)\s*-\s*([0-9.]+)\s*$/) { - unpack "N2", pack "N2", $1, $2; - } else { - die "$range: unable to parse ip range"; +sub is_ip_referral { + my ($self, $response) = @_; + $response =~ /^network-ip-network-block:(.*)$/m + or return (); + my $iprange = $1; + if ($response =~ /^REFERRAL: rwhois:\/\/([^\/]+)/m) { + my $server = $1; + if ($server =~ /^whois.ripe.net/) { + return ($iprange, $server{RIPE}); + } elsif ($server =~ /^rwhois.nic.ad.jp/) { + return ($iprange, $server{JPNIC}); + } elsif ($server =~ /^r?whois.apnic.net/) { + return ($iprange, $server{APNIC}); + } elsif ($server =~ /^rwhois.lacnic.net/) { + return ($iprange, $server{LACNIC}); # not yet seen, hope it will be implemented like this + } elsif ($server =~ /^rwhois.internex.net/) { + # alive(!) + return (); + } elsif ($server =~ /^rwhois.nstar.net/) { + return (); + } elsif ($server =~ /^rwhois.sesqui.net/) { + return (); + } elsif ($server =~ /^nic.ddn.mil/) { + # whois.nic.mil (the actual address) only supports the antique + # nonparsable arin whois format + return (); + } else { + die "$response\nreferral to whois server $server"; + } + die "$server $iprange"; + } elsif ($response =~ /^network-org-name: Latin American and Caribbean IP address Regional Registry/m) { + return ($iprange, $server{LACNIC}); + } elsif ($response =~ /^network-org-name: Asia Pacific Network Information Centre/m) { + return ($iprange, $server{APNIC}); + } elsif ($response =~ /^network-org-name: RIPE Network Coordination Centre/m) { + return ($iprange, $server{RIPE}); } + (); } +package Net::Whois::IP; + # add a referral to a specific server sub add_referral { my ($netblock, $server) = @_; my ($ip0, $ip1) = ip_range $netblock; - $db_referral->db_put((pack "N*", $ip1, $ip0) ^ "\x00\x00\x00\x00\xff\xff\xff\xff", "S" . $server->{name}); + $db_referral->db_put( + (pack "N*", $ip1, $ip0) ^ "\x00\x00\x00\x00\xff\xff\xff\xff", + $server->{name}, + ); } # get all referrals @@ -291,6 +468,23 @@ } } +=item init db_home => $path, ... + +Initializes the module. + +This function must be called before calling any of the other functions, +and the only required agrument is C, the path where the module +will store it's cache (will be created if neccessary). + +Other Arguments: + + db_home database home directory + db_env the database env (should be created by the module itself) + db_errfile the file wheer the database will output and errors (/dev/fd/2) + db_cachesize size of the in-memory cache (1_000_000) + +=cut + sub init(;%) { my (%arg) = @_; $arg{db_home} or $arg{db_env} or Carp::croak "either db_home or db_env home must be set"; @@ -303,7 +497,7 @@ -ErrFile => $arg{db_errfile} || "/dev/fd/2", -ErrPrefix => "NET-WHOIS-IP", -Verbose => 1, - -Flags => DB_CREATE|DB_RECOVER|DB_INIT_MPOOL|DB_INIT_TXN + -Flags => DB_CREATE|DB_RECOVER_FATAL|DB_INIT_MPOOL|DB_INIT_TXN or die "$arg{db_home}: unable to create database home"; }; @@ -317,60 +511,240 @@ $db_referral = new_btree "referral"; - add_referral "129.13.0.0/16", $ripe; - add_referral "200.0.0.0/8", $lacnic; - add_referral "200.128.0.0/9", $brnic; - parse_referral "32.0.0.0", $ripe; parse_referral "202.0.0.0", $apnic; parse_referral "192.50.0.0", $apnic; + add_referral "129.13.0.0/16", $ripe; add_referral "133.0.0.0/8", $jpnic; + add_referral "200.0.0.0/8", $lacnic; + add_referral "200.128.0.0/9", $brnic; } -### +=item ip_query $ip + +Queries the whois server for the given ip address (which must be something +inet_aton understands). -init db_home => "/tmp/whois"; +The return value currently is a hash, which looks slightly difefrent for +different registries, see examples. + +=cut sub ip_query { my $ip = shift; - print "Q?$ip "; - my $server = $arin; + my ($prev_response, $prev_server); + +referral: my $c = $db_referral->db_cursor; + # iterate over all possibly matching referral ranges + # and choose the one that fits tightest my ($k, $v) = (inet_aton $ip); if (!$c->c_get($k, $v, DB_SET_RANGE)) { - my ($ip1, $ip0) = unpack "N*", $k ^ "\x00\x00\x00\x00\xff\xff\xff\xff"; - my $ipn = unpack "N", inet_aton $ip; +find: { + do { + my ($ip1, $ip0) = unpack "N*", $k ^ "\x00\x00\x00\x00\xff\xff\xff\xff"; + my $ipn = unpack "N", inet_aton $ip; + 0 && printf "Q=%15s < %15s < %15s, $v\n", + (inet_ntoa pack "N", $ip0), + (inet_ntoa pack "N", $ipn), + (inet_ntoa pack "N", $ip1); + + if ($ipn <= $ip1) { + if ($ip0 <= $ipn) { + my ($name, $rip) = split /\t/, $v; + $server = $server{$name} if $server{$name}; + $ip = $ip if $rip; + last; + } + } else { + last; + } + } while !$c->c_get($k, $v, DB_NEXT); + } + } - if ($ip0 <= $ipn && $ipn <= $ip1) { - if ($v =~ s/^S//) { - $server = $server{$v} if $server{$v}; - } elsif ($v =~ s/^I//) { - die; - } else { - # database corrupted or newer - } + my $response = $server->ip_query($ip); + if ($response) { + if (my ($iprange, $refer) = $server->is_ip_referral($response)) { + ($prev_server, $prev_response) = ($server, $response); + $server = $refer; + add_referral $iprange, $server; + goto referral; } + } else { + ($server, $response) = ($prev_server, $prev_response); } - print "($ip,$server->{name})\n"; - $server->parse_ip_response($server->ip_query($ip)); -} + if (!$response) { + ($server, $response) = ($arin, $arin->ip_query($ip)); + } + + my $res = $server->parse_ip_response($response); + for my $range (@{$res->{netblock} || []}) { + if (my ($ip0, $ip1) = eval { ip_range $range }) { + # limit to /24 + my $ipn = unpack "N", inet_aton $ip; + $ip0 = $ipn & 0xffffff00 if $ip0 < ($ipn & 0xffffff00); + $ip1 = ($ipn + 256 & 0xffffff00) - 1 if $ip1 > ($ipn + 256 & 0xffffff00); + $db_referral->db_put( + (pack "N*", $ip1, $ip0) ^ "\x00\x00\x00\x00\xff\xff\xff\xff", + "$server->{name}\t$ip", + ); + } + } + + $db_env->txn_checkpoint(10,1,0); -for (qw(132.64.0.0 129.13.162.91 193.166.90.111 213.189.83.103 161.142.8.76 66.68.103.189 200.149.85.112 210.49.200.207 133.11.128.254)) { - use PApp::Util; - warn PApp::Util::dumpval ip_query($_); + $res; } -exit; +1; + +=back -__END__ +=head2 WHOIS EXAMPLES -1; +=over 4 + +=item RIPE + + ip_query "129.13.162.91" => + ( + source => [ "RIPE" ], + "mnt-by" => [ "DFN-NTFY" ], + country => [ "DE" ], + netname => [ "KLICK" ], + status => [ "ASSIGNED PI" ], + description => [ "Karlsruher Lichtleiter Kommunikationsnetz", + "University of Karlsruhe", + "Germany" ], + nameserver => [ "netserv.rz.uni-karlsruhe.de", + "iraun1.ira.uka.de", + "deneb.dfn.de", + "ns.germany.eu.net" ], + "tech-c" => [ "HUK2-RIPE" ], + changed => [ "lortz\@rz.uni-karlsruhe.de 19910212", + "nipper\@ira.uka.de 19920422", + "nipper\@xlink.net 19930513", + "rv\@Informatik.Uni-Dortmund.DE 19931129", + "poldi\@dfn.de 19940309", + "dolderer\@nic.de 19940930", + "dolderer\@nic.de 19970821", + "schweikh\@noc 19990819" ], + netblock => [ "129.13.0.0 - 129.13.255.255" ], + "admin-c" => [ "BL118" ], + notify => [ "guardian\@nic.de" ], + whois_server => "RIPE" + ) + +=item LACNIC + + ip_query "200.5.0.0" => + ( + source => [ "ARIN-LACNIC-TRANSITION" ], + created => [ 19960205 ], + country => [ "PR" ], + changed => [ 19960205 ], + "owner-c" => [ "PR-PRMS-LACNIC", + "RS564-ARIN" ], + netblock => [ "200.5.0/21" ], + status => [ "assigned" ], + description => [ "Puerto Rico Medical Services Administration", + "Management Information Systems Department", + "PO Box 2129", + "San Juan, PR 00922-2129", + "PR" ], + whois_server => "LACNIC" + ) + +=item BRNIC + + ip_query "200.128.0.0" => + ( + created => [ 20000215 ], + "tech-c" => [ "ALG149" ], + changed => [ 20001017 ], + "owner-c" => [ "003.508.097/0001-36", + "ALG149" ], + netblock => [ "200.128/16" ], + "abuse-c" => [ "SIC128" ], + description => [ "Associa\347\343o Rede Nacional de Ensino e Pesquisa", + "Estrada Dona Castorina, 110, 353", + "22460-320 - Rio de Janeiro - RJ", + "(021) 274-7445 []" ], + whois_server => "BRNIC", + nameserver => [ "NS.POP-BA.RNP.BR", + "SERVER1.POP-DF.RNP.BR", + "SERVER1.AGR.UFBA.BR", + "DNS.UFBA.BR" ] + ) + +=item JPNIC + + ip_query "133.11.128.254" => + ( + created => [ "" ], + "tech-c" => [ "AK003JP", + "MN010JP" ], + netname => [ "UTSNET" ], + changed => [ "2002/10/15 13:06:48 (JST)\n kato\@wide.ad.jp" ], + netblock => [ "133.11.0.0" ], + "admin-c" => [ "MN010JP" ], + description => [ "University of Tokyo" ], + whois_server => "JPNIC", + expires => [ "" ], + nameserver => [ "dns1.nc.u-tokyo.ac.jp", + "dns2.nc.u-tokyo.ac.jp", + "dns3.nc.u-tokyo.ac.jp", + "ns.nc.u-tokyo.ac.jp", + "ns.s.u-tokyo.ac.jp" ] + ) + +=item APNIC + + ip_query "203.2.75.99" => + ( + source => [ "APNIC" ], + "mnt-by" => [ "APNIC-HM" ], + "tech-c" => [ "TN38-AP" ], + country => [ "AU" ], + netname => [ "OPTUSINTERNET-AU" ], + changed => [ "nobody\@aunic.net 20010524", + "aunic-transfer\@apnic.net 20010525", + "hostmaster\@apnic.net 20011004" ], + netblock => [ "203.2.75.0 - 203.2.75.255" ], + status => [ "ALLOCATED PORTABLE" ], + "admin-c" => [ "TN38-AP" ], + description => [ "OPTUS INTERNET - RETAIL", + "INTERNET SERVICES", + "St Leonards, NSW" ], + whois_server => "APNIC" + ) + +=item ARIN + + ip_query "68.52.164.8" => + ( + country => [ "US" ], + netname => [ "JUMPSTART-DC-5" ], + "auth-area" => [ "0.0.0.0/0" ], + description => [ "Comcast Cable Communications, Inc." ], + created => [ "20200718050000000" ], + "tech-c" => [ "FG200-ARIN.0.0.0.0/0" ], + changed => [ "19200307050000000" ], + handle => [ "NET-68-52-160-0-1" ], + netblock => [ "68.52.160.0 - 68.52.175.255" ], + id => [ "NET-68-52-160-0-1.0.0.0.0/0" ], + address => [ "3 Executive Campus Cherry Hill", + "NJ", + "08002" ], + whois_server => "ARIN" + ) =back