Net-Whois-IP/IP.pm

=head1 NAME

Net::Whois::IP - find whois data for ip addresses

=head1 SYNOPSIS

 use Net::Whois::IP;

=head1 DESCRIPTION

=over 4

=cut

package Net::Whois::IP;

BEGIN {
   $VERSION = 0.01;
   @EXPORT_OK = qw();
}

use base Exporter;

use Carp;

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";
}

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 {
   my $class = shift;
   my $self = bless {
      name => @_,
   }, $class;
   $self->{request} ||= new Coro::Channel $self->{request_backlog} || 10;
   $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, $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;
}

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;

   $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->sanitize_ip_response($self->_query($ip));
}

sub sanitize_ip_response {
   my ($self, $response) = @_;
   $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";
      }
   }
   $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;

# plain whois, as used by ripe and apnic

use base Net::Whois::IP::base;

sub _daemon {
   my $self = shift;
   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;
      $request->{response} =~ /^% query rate limit exceeded/im and $self->_failure(9), redo;

      $self->_ok;
      $request->{ready}->up;
   }
}

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 =~ /^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;

# totally different result format

use base Net::Whois::IP::whois;

sub ip_query {
   my ($self, $ip) = @_;
   $self->SUPER::ip_query("$ip/e");
}

sub sanitize_ip_response {
   my ($self, $response) = @_;
   $response =~ s/^\[\s.*//mg;
   $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;

# keepalive whois, as used by ripe and apnic

use base Net::Whois::IP::whois;

sub _daemon {
   my $self = shift;
   my $fh;

   my $request;
   while ($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;
   }
}

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, of course, as usual arin's implementation is utterly broken
# and doesn't help very much

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]+$/\012/g;
      $response .= $line;
      $line =~ /^%(ok|error)/ and return $response;
   }
   return;
}

sub _daemon {
   my $self = shift;
   my $request;
   while ($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 sanitize_ip_response {
   my ($self, $response) = @_;
   $response =~ s/^% referral/REFERRAL:/mg;
   $response =~ s/^%.*//mg;
   $response =~ s/\n\n.*//s;
   $response = "" if $response =~ /^network:Org-Name:Various Registries \(Maintained by ARIN\)/m;
   $response =~ s/^([^:]+):([^:]+):/$1-\L$2: /mg;
   $response;
}

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",
   });
}

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",
         $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;
   }
}

=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<db_home>, 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";
   $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_FATAL|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";

   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).

The return value currently is a hash, which looks slightly difefrent for
different registries, see examples.

=cut

sub ip_query {
   my $ip = shift;

   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)) {
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);
      }
   }

   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);
   }

   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);

   $res;
}

1;

=back

=head2 WHOIS EXAMPLES

=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

=head1 AUTHOR

 Marc Lehmann <pcg@goof.com>
 http://www.goof.com/pcg/marc/

=cut

Revision:	1.3
Committed:	Sun Dec 1 14:51:23 2002 UTC (23 years ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.2:	+464 -90 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Net::Whois::IP - find whois data for ip addresses
4
5			=head1 SYNOPSIS
6
7			use Net::Whois::IP;
8
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15			package Net::Whois::IP;
16
17			BEGIN {
18			$VERSION = 0.01;
19			@EXPORT_OK = qw();
20			}
21
22			use base Exporter;
23
24	root	1.2	use Carp;
25
26			use Socket;
27
28			use BerkeleyDB;
29
30			use Coro;
31			use Coro::Event;
32			use Coro::Semaphore;
33			use Coro::SemaphoreSet;
34			use Coro::Socket;
35			use Coro::Timer;
36			use Coro::Channel;
37
38			my %server;
39
40			sub new_btree {
41			new BerkeleyDB::Btree
42			-Env => $db_env,
43			-Filename => $_[0],
44			-Flags => DB_CREATE,
45			or die "$_[0]: unable to create/open table";
46			}
47
48	root	1.3	sub ip_range {
49			my $range = $_[0];
50
51			if ($range =~ /^
52			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
53			(?:\.
54			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
55			(?:\.
56			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
57			(?:\.
58			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
59			)?
60			)?
61			)?
62			\/
63			([0-9]+)
64			$/x) {
65			my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4;
66			my $net = 1 << (31 - $5);
67			my $mask = inet_aton 2 ** 32 - $net;
68
69			my $ip1 = $ip & $mask;
70			my $ip2 = $ip1 \| inet_aton $net * 2 - 1;
71			return unpack "N2", "$ip1$ip2";
72			} elsif ($range =~ /^\s([0-9.]+)\s-\s([0-9.]+)\s$/) {
73			unpack "N*", (inet_aton $1) . (inet_aton $2);
74			} else {
75			die "$range: unable to parse ip range";
76			}
77			}
78
79	root	1.2	package Net::Whois::IP::base;
80
81			sub new {
82			my $class = shift;
83			my $self = bless {
84			name => @_,
85			}, $class;
86			$self->{request} \|\|= new Coro::Channel $self->{request_backlog} \|\| 10;
87	root	1.3	$self->{daemon} = Coro::async {
88			while () {
89			eval { $self->_daemon };
90			warn "restarting daemon for whois server $self->{name}: $@";
91			}
92			};
93			$self->{daemon}->prio(1);
94	root	1.2	$self->{cache} = Net::Whois::IP::new_btree "whois_" . lc $self->{name};
95			$server{$self->{name}} = $self;
96			}
97
98			sub _failure {
99	root	1.3	my ($self, $min) = shift;
100	root	1.2	undef $self->{fh};
101	root	1.3	$self->{retry} = $min if $self->{retry} < $min;
102	root	1.2	Coro::Timer::sleep 1.5 ** $self->{retry} - 2 if $self->{retry};
103			$self->{retry}++ if $self->{retry} < 17;
104			}
105
106			sub _ok {
107			my $self = shift;
108			$self->{retry} = 0;
109			}
110
111			sub _query {
112			my ($self, $query) = @_;
113
114			my $response;
115
116			if (!$self->{cache}->db_get($query, $response)) {
117			$response =~ s/^[^\x00]+\x00//;
118			return $response;
119			}
120
121			my $request = {
122			ready => (new Coro::Semaphore 0),
123			query => $query,
124			};
125
126			$self->{request}->put($request);
127			$request->{ready}->down;
128
129	root	1.3	$request->{response} =~ s/\015//g;
130			$request->{response} =~ s/\012/\n/g if "\012" ne "\n";
131
132	root	1.2	$response = time . "\x00" . $request->{response};
133
134			$self->{cache}->db_put($query, $response);
135	root	1.3
136	root	1.2	$request->{response};
137			}
138
139			sub ip_query {
140			my ($self, $ip) = @_;
141	root	1.3	$self->sanitize_ip_response($self->_query($ip));
142			}
143
144			sub sanitize_ip_response {
145			my ($self, $response) = @_;
146			$response;
147	root	1.2	}
148
149			sub parse_ip_response {
150	root	1.3	my ($self, $response, $tags, $res) = @_;
151			$res->{whois_server} = $self->{name};
152			while ($response =~ /^([^:]+):[ \t]*
153			(
154			.*
155			(?:\n[\t ].)
156			)
157			/mgx) {
158			my ($tag, $val) = ($1, $2);
159			if (exists $tags->{$tag}) {
160			push @{$res->{$tags->{$tag}}}, $val if defined $tags->{$tag};
161			} else {
162			use Carp;
163			confess "unknown tag $tag=$val";
164			}
165			}
166			$res;
167			}
168
169			# check wether the given response is a referral to another server
170			# find out which one, and the ip range we were referred
171			sub is_ip_referral {
172	root	1.2	my ($self, $response) = @_;
173	root	1.3	# ($iprange, $server)
174			();
175	root	1.2	}
176
177			package Net::Whois::IP::whois;
178
179			# plain whois, as used by ripe and apnic
180
181			use base Net::Whois::IP::base;
182
183			sub _daemon {
184			my $self = shift;
185	root	1.3	my $request;
186			while ($request = $self->{request}->get) {
187	root	1.2	my $fh = new Coro::Socket PeerHost => $self->{server}
188			or $self->_failure, redo;
189
190			$fh->print("$request->{query}\012");
191			$fh->sysread($request->{response}, 16384);
192	root	1.3
193			length $request->{response} or $self->_failure, redo;
194			$request->{response} =~ /^% query rate limit exceeded/im and $self->_failure(9), redo;
195	root	1.2
196			$self->_ok;
197			$request->{ready}->up;
198			}
199			}
200
201	root	1.3	sub sanitize_ip_response {
202			my ($self, $response) = @_;
203			$response = "" if $response =~ /^% not assigned/im;
204			$response =~ s/^%.*//mg;
205			$response =~ s/[ \t]+$//mg; # brnic, maybe others
206			$response =~ s/^\n+//;
207			$response =~ s/\n\n.*//s;
208			$self->SUPER::sanitize_ip_response($response);
209	root	1.2	}
210
211			sub parse_ip_response {
212	root	1.3	my ($self, $response, $tags) = @_;
213			$self->SUPER::parse_ip_response($response, $tags \|\| {
214			inetnum => "netblock",
215			netname => "netname",
216			descr => "description",
217			owner => "description",
218			address => "description",
219			phone => "description",
220			country => "country",
221			ownerid => "owner-c",
222			"admin-c" => "admin-c",
223			"tech-c" => "tech-c",
224			"owner-c" => "owner-c",
225			"abuse-c" => "abuse-c",
226			status => "status",
227			notify => "notify",
228			changed => "changed",
229			created => "created",
230			source => "source",
231			remarks => "remarks",
232			"mnt-by" => "mnt-by",
233			"mnt-irt" => "irt-c", # incident response team
234			"rev-srv" => "nameserver",
235			nserver => "nameserver",
236			"mnt-lower" => undef,
237			"mnt-routes"=> undef,
238			responsible => undef,
239			nsstat => undef,
240			nslastaa => undef,
241			"aut-num" => undef,
242			inetrev => undef, # nameserver-dependent
243			"inetnum-up" => undef,
244			});
245			}
246
247			sub is_ip_referral {
248	root	1.2	my ($self, $response) = @_;
249	root	1.3	$response =~ /^inetnum:\s+(.*)/m
250			or return;
251			my $iprange = $1;
252			if ($response =~ /^remarks:\s+These addresses have been further assigned to Brazilian users./m) {
253			return ($iprange, $server{BRNIC});
254			}
255			# ($iprange, $server)
256			();
257	root	1.2	}
258
259			package Net::Whois::IP::jpnic;
260
261			# totally different result format
262
263			use base Net::Whois::IP::whois;
264
265			sub ip_query {
266			my ($self, $ip) = @_;
267			$self->SUPER::ip_query("$ip/e");
268			}
269
270	root	1.3	sub sanitize_ip_response {
271			my ($self, $response) = @_;
272			$response =~ s/^\[\s.*//mg;
273			$response =~ s/^(?:\w\.\ )? \[ ([^\]]+) \] (.*)/$1: $2/mgx;
274			$self->SUPER::sanitize_ip_response($response);
275			}
276
277	root	1.2	sub parse_ip_response {
278			my ($self, $response) = @_;
279	root	1.3	$self->SUPER::parse_ip_response($response, {
280			"Network Information" => undef,
281			"Network Number" => "netblock",
282			"Network Name" => "netname",
283			"Organization" => "description",
284			"Administrative Contact" => "admin-c",
285			"Technical Contact" => "tech-c",
286			"Nameserver" => "nameserver",
287			"Reply Mail" => undef,
288			"Assigned Date" => "created",
289			"Return Date" => "expires",
290			"Last Update" => "changed",
291			}, {
292			country => "JP",
293			});
294	root	1.2	}
295
296			package Net::Whois::IP::ripe;
297
298			# keepalive whois, as used by ripe and apnic
299
300			use base Net::Whois::IP::whois;
301
302			sub _daemon {
303			my $self = shift;
304			my $fh;
305
306	root	1.3	my $request;
307			while ($request = $self->{request}->get) {
308	root	1.2	unless ($self->{fh}) {
309			$fh = new Coro::Socket PeerHost => $self->{server};
310			$fh or $self->_failure, redo;
311			}
312
313			$fh->print("-k $request->{query}\012");
314			$request->{response} = $fh->readline("\012\012\012");
315			length $request->{response}
316			or $self->_failure, redo;
317
318			$self->_ok;
319			$request->{ready}->up;
320			}
321			}
322
323	root	1.3	sub sanitize_ip_response {
324			my ($self, $response) = @_;
325			$response = "" if $response =~ /^netname:\s+IANA-BLK$/m;
326			$response = "" if $response =~ /This network range is not allocated to APNIC./;
327			# $response = "" if $response =~ /^remarks:\s+.*the IP has not been allocated by APNIC./m;
328			$self->SUPER::sanitize_ip_response($response);
329			}
330
331	root	1.2	package Net::Whois::IP::rwhois;
332
333	root	1.3	# rwhois 1.5, of course, as usual arin's implementation is utterly broken
334			# and doesn't help very much
335	root	1.2
336			use base Net::Whois::IP::base;
337
338			sub _request {
339			my $self = shift;
340			my ($response, $error);
341
342			$self->{fh}->print("$_[0]\015\012");
343			while (defined (my $line = $self->{fh}->readline)) {
344	root	1.3	$line =~ s/[\015\012]+$/\012/g;
345	root	1.2	$response .= $line;
346			$line =~ /^%(ok\|error)/ and return $response;
347			}
348			return;
349			}
350
351			sub _daemon {
352			my $self = shift;
353	root	1.3	my $request;
354			while ($request = $self->{request}->get) {
355	root	1.2	unless ($self->{fh}) {
356			$self->{fh} = new Coro::Socket PeerHost => $self->{server};
357			$self->{fh} or $self->_failure, redo;
358			$self->{fh}->readline =~ /^%rwhois / or $self->_failure, redo;
359			$self->_request("-rwhois V-1.5 Net::Whois::IP") or $self->_failure, redo;
360			$self->_request("-forward off") or $self->_failure, redo;
361			$self->_request("-holdconnect on") or $self->_failure, redo;
362			}
363			$request->{response} = $self->_request($request->{query})
364			or $self->_failure, redo;
365			$request->{response} =~ s/^%error 330.*/%ok/m;
366			$self->_ok;
367			$request->{ready}->up;
368			}
369			}
370
371			sub ip_query {
372			my ($self, $ip) = @_;
373			$self->SUPER::ip_query("network $ip");
374			}
375
376	root	1.3	sub sanitize_ip_response {
377	root	1.2	my ($self, $response) = @_;
378	root	1.3	$response =~ s/^% referral/REFERRAL:/mg;
379			$response =~ s/^%.*//mg;
380			$response =~ s/\n\n.*//s;
381			$response = "" if $response =~ /^network:Org-Name:Various Registries \(Maintained by ARIN\)/m;
382	root	1.2	$response =~ s/^([^:]+):([^:]+):/$1-\L$2: /mg;
383	root	1.3	$response;
384	root	1.2	}
385
386	root	1.3	sub parse_ip_response {
387			my ($self, $response) = @_;
388			$self->SUPER::parse_ip_response($response, {
389			"network-class-name" => undef,
390			"network-auth-area" => "auth-area",
391			"network-id" => "id",
392			"network-handle" => "handle",
393			"network-network-name" => "netname",
394			"network-ip-network" => undef,
395			"network-ip-network-block" => "netblock",
396			"network-org-name" => "description",
397			"network-street-address" => "address",
398			"network-city" => "address",
399			"network-state" => "address",
400			"network-postal-code" => "address",
401			"network-country-code" => "country",
402			"network-tech-contact;i" => "tech-c",
403			"network-admin-contact;i" => "admin-c",
404			"network-created" => "created",
405			"network-updated" => "changed",
406			});
407			}
408	root	1.2
409	root	1.3	sub is_ip_referral {
410			my ($self, $response) = @_;
411			$response =~ /^network-ip-network-block:(.*)$/m
412			or return ();
413			my $iprange = $1;
414			if ($response =~ /^REFERRAL: rwhois:\/\/([^\/]+)/m) {
415			my $server = $1;
416			if ($server =~ /^whois.ripe.net/) {
417			return ($iprange, $server{RIPE});
418			} elsif ($server =~ /^rwhois.nic.ad.jp/) {
419			return ($iprange, $server{JPNIC});
420			} elsif ($server =~ /^r?whois.apnic.net/) {
421			return ($iprange, $server{APNIC});
422			} elsif ($server =~ /^rwhois.lacnic.net/) {
423			return ($iprange, $server{LACNIC}); # not yet seen, hope it will be implemented like this
424			} elsif ($server =~ /^rwhois.internex.net/) {
425			# alive(!)
426			return ();
427			} elsif ($server =~ /^rwhois.nstar.net/) {
428			return ();
429			} elsif ($server =~ /^rwhois.sesqui.net/) {
430			return ();
431			} elsif ($server =~ /^nic.ddn.mil/) {
432			# whois.nic.mil (the actual address) only supports the antique
433			# nonparsable arin whois format
434			return ();
435			} else {
436			die "$response\nreferral to whois server $server";
437			}
438			die "$server $iprange";
439			} elsif ($response =~ /^network-org-name: Latin American and Caribbean IP address Regional Registry/m) {
440			return ($iprange, $server{LACNIC});
441			} elsif ($response =~ /^network-org-name: Asia Pacific Network Information Centre/m) {
442			return ($iprange, $server{APNIC});
443			} elsif ($response =~ /^network-org-name: RIPE Network Coordination Centre/m) {
444			return ($iprange, $server{RIPE});
445	root	1.2	}
446	root	1.3	();
447	root	1.2	}
448
449	root	1.3	package Net::Whois::IP;
450
451	root	1.2	# add a referral to a specific server
452			sub add_referral {
453			my ($netblock, $server) = @_;
454			my ($ip0, $ip1) = ip_range $netblock;
455	root	1.3	$db_referral->db_put(
456			(pack "N*", $ip1, $ip0) ^ "\x00\x00\x00\x00\xff\xff\xff\xff",
457			$server->{name},
458			);
459	root	1.2	}
460
461			# get all referrals
462			sub parse_referral {
463			my ($query, $server) = @_;
464			my $referral = $arin->_query("referral $query");
465
466			while ($referral =~ /^referral:Referred-Auth-Area:([0-9.\/]+)$/mg) {
467			add_referral $1, $server;
468			}
469			}
470
471	root	1.3	=item init db_home => $path, ...
472
473			Initializes the module.
474
475			This function must be called before calling any of the other functions,
476			and the only required agrument is C<db_home>, the path where the module
477			will store it's cache (will be created if neccessary).
478
479			Other Arguments:
480
481			db_home database home directory
482			db_env the database env (should be created by the module itself)
483			db_errfile the file wheer the database will output and errors (/dev/fd/2)
484			db_cachesize size of the in-memory cache (1_000_000)
485
486			=cut
487
488	root	1.2	sub init(;%) {
489			my (%arg) = @_;
490			$arg{db_home} or $arg{db_env} or Carp::croak "either db_home or db_env home must be set";
491			$db_env = $arg{db_env} \|\| do {
492			mkdir $arg{db_home}, 0700;
493
494			$db_env = new BerkeleyDB::Env
495			-Home => $arg{db_home},
496			-Cachesize => $arg{db_cachesize} \|\| 1_000_000,
497			-ErrFile => $arg{db_errfile} \|\| "/dev/fd/2",
498			-ErrPrefix => "NET-WHOIS-IP",
499			-Verbose => 1,
500	root	1.3	-Flags => DB_CREATE\|DB_RECOVER_FATAL\|DB_INIT_MPOOL\|DB_INIT_TXN
501	root	1.2	or die "$arg{db_home}: unable to create database home";
502			};
503
504			$arin = new Net::Whois::IP::rwhois "ARIN", server => "rwhois.arin.net:rwhois(4321)";
505
506			$ripe = new Net::Whois::IP::ripe "RIPE", server => "whois.ripe.net:whois(43)";
507			$lacnic = new Net::Whois::IP::whois "LACNIC", server => "whois.lacnic.net:whois(43)";
508			$brnic = new Net::Whois::IP::whois "BRNIC", server => "whois.registro.br:whois(43)";
509			$apnic = new Net::Whois::IP::ripe "APNIC", server => "whois.apnic.net:whois(43)";
510			$jpnic = new Net::Whois::IP::jpnic "JPNIC", server => "whois.nic.ad.jp:whois(43)";
511
512			$db_referral = new_btree "referral";
513
514			parse_referral "32.0.0.0", $ripe;
515			parse_referral "202.0.0.0", $apnic;
516			parse_referral "192.50.0.0", $apnic;
517
518	root	1.3	add_referral "129.13.0.0/16", $ripe;
519	root	1.2	add_referral "133.0.0.0/8", $jpnic;
520	root	1.3	add_referral "200.0.0.0/8", $lacnic;
521			add_referral "200.128.0.0/9", $brnic;
522	root	1.2	}
523
524	root	1.3	=item ip_query $ip
525
526			Queries the whois server for the given ip address (which must be something
527			inet_aton understands).
528
529			The return value currently is a hash, which looks slightly difefrent for
530			different registries, see examples.
531	root	1.2
532	root	1.3	=cut
533	root	1.2
534			sub ip_query {
535			my $ip = shift;
536
537	root	1.3	my $server = $arin;
538	root	1.2
539	root	1.3	my ($prev_response, $prev_server);
540	root	1.2
541	root	1.3	referral:
542	root	1.2	my $c = $db_referral->db_cursor;
543
544	root	1.3	# iterate over all possibly matching referral ranges
545			# and choose the one that fits tightest
546	root	1.2	my ($k, $v) = (inet_aton $ip);
547			if (!$c->c_get($k, $v, DB_SET_RANGE)) {
548	root	1.3	find: {
549			do {
550			my ($ip1, $ip0) = unpack "N*", $k ^ "\x00\x00\x00\x00\xff\xff\xff\xff";
551			my $ipn = unpack "N", inet_aton $ip;
552			0 && printf "Q=%15s < %15s < %15s, $v\n",
553			(inet_ntoa pack "N", $ip0),
554			(inet_ntoa pack "N", $ipn),
555			(inet_ntoa pack "N", $ip1);
556
557			if ($ipn <= $ip1) {
558			if ($ip0 <= $ipn) {
559			my ($name, $rip) = split /\t/, $v;
560			$server = $server{$name} if $server{$name};
561			$ip = $ip if $rip;
562			last;
563			}
564			} else {
565			last;
566			}
567			} while !$c->c_get($k, $v, DB_NEXT);
568			}
569			}
570
571			my $response = $server->ip_query($ip);
572			if ($response) {
573			if (my ($iprange, $refer) = $server->is_ip_referral($response)) {
574			($prev_server, $prev_response) = ($server, $response);
575			$server = $refer;
576			add_referral $iprange, $server;
577			goto referral;
578			}
579			} else {
580			($server, $response) = ($prev_server, $prev_response);
581			}
582	root	1.2
583	root	1.3	if (!$response) {
584			($server, $response) = ($arin, $arin->ip_query($ip));
585			}
586
587			my $res = $server->parse_ip_response($response);
588			for my $range (@{$res->{netblock} \|\| []}) {
589			if (my ($ip0, $ip1) = eval { ip_range $range }) {
590			# limit to /24
591			my $ipn = unpack "N", inet_aton $ip;
592			$ip0 = $ipn & 0xffffff00 if $ip0 < ($ipn & 0xffffff00);
593			$ip1 = ($ipn + 256 & 0xffffff00) - 1 if $ip1 > ($ipn + 256 & 0xffffff00);
594			$db_referral->db_put(
595			(pack "N*", $ip1, $ip0) ^ "\x00\x00\x00\x00\xff\xff\xff\xff",
596			"$server->{name}\t$ip",
597			);
598	root	1.2	}
599			}
600
601	root	1.3	$db_env->txn_checkpoint(10,1,0);
602
603			$res;
604	root	1.2	}
605
606	root	1.3	1;
607
608			=back
609
610			=head2 WHOIS EXAMPLES
611	root	1.2
612	root	1.3	=over 4
613	root	1.1
614	root	1.3	=item RIPE
615	root	1.1
616	root	1.3	ip_query "129.13.162.91" =>
617			(
618			source => [ "RIPE" ],
619			"mnt-by" => [ "DFN-NTFY" ],
620			country => [ "DE" ],
621			netname => [ "KLICK" ],
622			status => [ "ASSIGNED PI" ],
623			description => [ "Karlsruher Lichtleiter Kommunikationsnetz",
624			"University of Karlsruhe",
625			"Germany" ],
626			nameserver => [ "netserv.rz.uni-karlsruhe.de",
627			"iraun1.ira.uka.de",
628			"deneb.dfn.de",
629			"ns.germany.eu.net" ],
630			"tech-c" => [ "HUK2-RIPE" ],
631			changed => [ "lortz\@rz.uni-karlsruhe.de 19910212",
632			"nipper\@ira.uka.de 19920422",
633			"nipper\@xlink.net 19930513",
634			"rv\@Informatik.Uni-Dortmund.DE 19931129",
635			"poldi\@dfn.de 19940309",
636			"dolderer\@nic.de 19940930",
637			"dolderer\@nic.de 19970821",
638			"schweikh\@noc 19990819" ],
639			netblock => [ "129.13.0.0 - 129.13.255.255" ],
640			"admin-c" => [ "BL118" ],
641			notify => [ "guardian\@nic.de" ],
642			whois_server => "RIPE"
643			)
644
645			=item LACNIC
646
647			ip_query "200.5.0.0" =>
648			(
649			source => [ "ARIN-LACNIC-TRANSITION" ],
650			created => [ 19960205 ],
651			country => [ "PR" ],
652			changed => [ 19960205 ],
653			"owner-c" => [ "PR-PRMS-LACNIC",
654			"RS564-ARIN" ],
655			netblock => [ "200.5.0/21" ],
656			status => [ "assigned" ],
657			description => [ "Puerto Rico Medical Services Administration",
658			"Management Information Systems Department",
659			"PO Box 2129",
660			"San Juan, PR 00922-2129",
661			"PR" ],
662			whois_server => "LACNIC"
663			)
664
665			=item BRNIC
666
667			ip_query "200.128.0.0" =>
668			(
669			created => [ 20000215 ],
670			"tech-c" => [ "ALG149" ],
671			changed => [ 20001017 ],
672			"owner-c" => [ "003.508.097/0001-36",
673			"ALG149" ],
674			netblock => [ "200.128/16" ],
675			"abuse-c" => [ "SIC128" ],
676			description => [ "Associa\347\343o Rede Nacional de Ensino e Pesquisa",
677			"Estrada Dona Castorina, 110, 353",
678			"22460-320 - Rio de Janeiro - RJ",
679			"(021) 274-7445 []" ],
680			whois_server => "BRNIC",
681			nameserver => [ "NS.POP-BA.RNP.BR",
682			"SERVER1.POP-DF.RNP.BR",
683			"SERVER1.AGR.UFBA.BR",
684			"DNS.UFBA.BR" ]
685			)
686
687			=item JPNIC
688
689			ip_query "133.11.128.254" =>
690			(
691			created => [ "" ],
692			"tech-c" => [ "AK003JP",
693			"MN010JP" ],
694			netname => [ "UTSNET" ],
695			changed => [ "2002/10/15 13:06:48 (JST)\n kato\@wide.ad.jp" ],
696			netblock => [ "133.11.0.0" ],
697			"admin-c" => [ "MN010JP" ],
698			description => [ "University of Tokyo" ],
699			whois_server => "JPNIC",
700			expires => [ "" ],
701			nameserver => [ "dns1.nc.u-tokyo.ac.jp",
702			"dns2.nc.u-tokyo.ac.jp",
703			"dns3.nc.u-tokyo.ac.jp",
704			"ns.nc.u-tokyo.ac.jp",
705			"ns.s.u-tokyo.ac.jp" ]
706			)
707
708			=item APNIC
709
710			ip_query "203.2.75.99" =>
711			(
712			source => [ "APNIC" ],
713			"mnt-by" => [ "APNIC-HM" ],
714			"tech-c" => [ "TN38-AP" ],
715			country => [ "AU" ],
716			netname => [ "OPTUSINTERNET-AU" ],
717			changed => [ "nobody\@aunic.net 20010524",
718			"aunic-transfer\@apnic.net 20010525",
719			"hostmaster\@apnic.net 20011004" ],
720			netblock => [ "203.2.75.0 - 203.2.75.255" ],
721			status => [ "ALLOCATED PORTABLE" ],
722			"admin-c" => [ "TN38-AP" ],
723			description => [ "OPTUS INTERNET - RETAIL",
724			"INTERNET SERVICES",
725			"St Leonards, NSW" ],
726			whois_server => "APNIC"
727			)
728
729			=item ARIN
730
731			ip_query "68.52.164.8" =>
732			(
733			country => [ "US" ],
734			netname => [ "JUMPSTART-DC-5" ],
735			"auth-area" => [ "0.0.0.0/0" ],
736			description => [ "Comcast Cable Communications, Inc." ],
737			created => [ "20200718050000000" ],
738			"tech-c" => [ "FG200-ARIN.0.0.0.0/0" ],
739			changed => [ "19200307050000000" ],
740			handle => [ "NET-68-52-160-0-1" ],
741			netblock => [ "68.52.160.0 - 68.52.175.255" ],
742			id => [ "NET-68-52-160-0-1.0.0.0.0/0" ],
743			address => [ "3 Executive Campus Cherry Hill",
744			"NJ",
745			"08002" ],
746			whois_server => "ARIN"
747			)
748	root	1.1
749			=back
750
751			=head1 AUTHOR
752
753			Marc Lehmann <pcg@goof.com>
754			http://www.goof.com/pcg/marc/
755
756			=cut
757