--- Net-Whois-IP/IP.pm 2002/11/28 10:34:13 1.1 +++ Net-Whois-IP/IP.pm 2002/11/30 02:45:47 1.2 @@ -12,6 +12,8 @@ =cut +# http://www.irr.net/docs/rpsl.html + package Net::Whois::IP; BEGIN { @@ -21,9 +23,352 @@ use base Exporter; -=item +use Carp; -=cut +use Socket; + +use BerkeleyDB; + +use Coro; +use Coro::Event; +use Coro::Semaphore; +use Coro::SemaphoreSet; +use Coro::Socket; +use Coro::Timer; +use Coro::Channel; + +my %server; + +sub new_btree { + new BerkeleyDB::Btree + -Env => $db_env, + -Filename => $_[0], + -Flags => DB_CREATE, + or die "$_[0]: unable to create/open table"; +} + +package Net::Whois::IP::base; + +sub new { + my $class = shift; + my $self = bless { + name => @_, + }, $class; + $self->{request} ||= new Coro::Channel $self->{request_backlog} || 10; + $self->{daemon} = Coro::async { shift->_daemon } $self; + $self->{cache} = Net::Whois::IP::new_btree "whois_" . lc $self->{name}; + $server{$self->{name}} = $self; +} + +sub _failure { + my $self = shift; + undef $self->{fh}; + Coro::Timer::sleep 1.5 ** $self->{retry} - 2 if $self->{retry}; + $self->{retry}++ if $self->{retry} < 17; +} + +sub _ok { + my $self = shift; + $self->{retry} = 0; +} + +sub _query { + my ($self, $query) = @_; + + my $response; + + if (!$self->{cache}->db_get($query, $response)) { + $response =~ s/^[^\x00]+\x00//; + return $response; + } + + my $request = { + ready => (new Coro::Semaphore 0), + query => $query, + }; + + $self->{request}->put($request); + $request->{ready}->down; + + $response = time . "\x00" . $request->{response}; + + $self->{cache}->db_put($query, $response); + + $request->{response}; +} + +sub ip_query { + my ($self, $ip) = @_; + $self->_query($ip); +} + +sub parse_ip_response { + my ($self, $response) = @_; + my %response; + while ($response =~ /^([^:]+):[ \t]*(.*)$/mg) { + push @{$response{$1}}, $2; + } + \%response; +} + +package Net::Whois::IP::whois; + +# plain whois, as used by ripe and apnic + +use base Net::Whois::IP::base; + +sub _daemon { + my $self = shift; + while (my $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; + + $self->_ok; + $request->{ready}->up; + } +} + +sub ip_query { + my ($self, $ip) = @_; + $self->SUPER::ip_query($ip); +} + +sub parse_ip_response { + my ($self, $response) = @_; + $response =~ s/^%.*//mg; + $response =~ s/^\012+//; + $response =~ s/\012\012.*//s; + $self->SUPER::parse_ip_response($response); +} + +package Net::Whois::IP::jpnic; + +# totally different result format + +use base Net::Whois::IP::whois; + +sub ip_query { + my ($self, $ip) = @_; + $self->SUPER::ip_query("$ip/e"); +} + +sub parse_ip_response { + my ($self, $response) = @_; + $response =~ s/^\[\s.*//mg; + $response =~ s/^(?:\w\.\ )? \[ ([^\]]+) \] (.*) (?:\012(?=\s))?/$1: $2/mgx; + $self->SUPER::parse_ip_response($response); +} + +package Net::Whois::IP::ripe; + +# keepalive whois, as used by ripe and apnic + +use base Net::Whois::IP::whois; + +sub _daemon { + my $self = shift; + my $fh; + + while (my $request = $self->{request}->get) { + unless ($self->{fh}) { + $fh = new Coro::Socket PeerHost => $self->{server}; + $fh or $self->_failure, redo; + } + + $fh->print("-k $request->{query}\012"); + $request->{response} = $fh->readline("\012\012\012"); + length $request->{response} + or $self->_failure, redo; + + $self->_ok; + $request->{ready}->up; + } +} + +package Net::Whois::IP::rwhois; + +# rwhois 1.5 + +use base Net::Whois::IP::base; + +sub _request { + my $self = shift; + my ($response, $error); + + $self->{fh}->print("$_[0]\015\012"); + while (defined (my $line = $self->{fh}->readline)) { + $line =~ s/[\015\012]+$/\n/g; + $response .= $line; + $line =~ /^%(ok|error)/ and return $response; + } + return; +} + +sub _daemon { + my $self = shift; + while (my $request = $self->{request}->get) { + unless ($self->{fh}) { + $self->{fh} = new Coro::Socket PeerHost => $self->{server}; + $self->{fh} or $self->_failure, redo; + $self->{fh}->readline =~ /^%rwhois / or $self->_failure, redo; + $self->_request("-rwhois V-1.5 Net::Whois::IP") or $self->_failure, redo; + $self->_request("-forward off") or $self->_failure, redo; + $self->_request("-holdconnect on") or $self->_failure, redo; + } + $request->{response} = $self->_request($request->{query}) + or $self->_failure, redo; + $request->{response} =~ s/^%error 330.*/%ok/m; + $self->_ok; + $request->{ready}->up; + } +} + +sub ip_query { + my ($self, $ip) = @_; + $self->SUPER::ip_query("network $ip"); +} + +sub parse_ip_response { + my ($self, $response) = @_; + $response =~ s/^([^:]+):([^:]+):/$1-\L$2: /mg; + $response =~ s/^%.*//mg; + $response =~ s/\012\012.*//s; + $self->SUPER::parse_ip_response($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; + + 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"; + } +} + +# 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}); +} + +# get all referrals +sub parse_referral { + my ($query, $server) = @_; + my $referral = $arin->_query("referral $query"); + + while ($referral =~ /^referral:Referred-Auth-Area:([0-9.\/]+)$/mg) { + add_referral $1, $server; + } +} + +sub init(;%) { + my (%arg) = @_; + $arg{db_home} or $arg{db_env} or Carp::croak "either db_home or db_env home must be set"; + $db_env = $arg{db_env} || do { + mkdir $arg{db_home}, 0700; + + $db_env = new BerkeleyDB::Env + -Home => $arg{db_home}, + -Cachesize => $arg{db_cachesize} || 1_000_000, + -ErrFile => $arg{db_errfile} || "/dev/fd/2", + -ErrPrefix => "NET-WHOIS-IP", + -Verbose => 1, + -Flags => DB_CREATE|DB_RECOVER|DB_INIT_MPOOL|DB_INIT_TXN + or die "$arg{db_home}: unable to create database home"; + }; + + $arin = new Net::Whois::IP::rwhois "ARIN", server => "rwhois.arin.net:rwhois(4321)"; + + $ripe = new Net::Whois::IP::ripe "RIPE", server => "whois.ripe.net:whois(43)"; + $lacnic = new Net::Whois::IP::whois "LACNIC", server => "whois.lacnic.net:whois(43)"; + $brnic = new Net::Whois::IP::whois "BRNIC", server => "whois.registro.br:whois(43)"; + $apnic = new Net::Whois::IP::ripe "APNIC", server => "whois.apnic.net:whois(43)"; + $jpnic = new Net::Whois::IP::jpnic "JPNIC", server => "whois.nic.ad.jp:whois(43)"; + + $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 "133.0.0.0/8", $jpnic; +} + +### + +init db_home => "/tmp/whois"; + +sub ip_query { + my $ip = shift; + + print "Q?$ip "; + + my $server = $arin; + + my $c = $db_referral->db_cursor; + + 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; + + 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 + } + } + } + + print "($ip,$server->{name})\n"; + $server->parse_ip_response($server->ip_query($ip)); +} + +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($_); +} + +exit; + +__END__ 1;