Coro/myhttpd/netgeo.pl

#!/usr/bin/perl

# APNIC refer: KRNIC (for 211.104.0.0)

use Socket;
use Fcntl;

use Coro;
use Coro::EV;
use Coro::Semaphore;
use Coro::SemaphoreSet;
use Coro::Socket;
use Coro::Timer;

use BerkeleyDB;

tie %netgeo::whois, BerkeleyDB::Btree,
    -Env => $db_env,
    -Filename => "whois",
    -Flags => DB_CREATE,
       or die "unable to create/open whois table";
$netgeo::iprange = new BerkeleyDB::Btree
    -Env => $db_env,
    -Filename => "iprange",
    -Flags => DB_CREATE,
       or die "unable to create/open iprange table";

package Whois;

use Coro::EV;

sub new {
   my $class = shift;
   my $name = shift;
   my $ip = shift;
   my $self = bless { name => $name, ip => $ip, @_ }, $class;
   $self->{maxjobs} = new Coro::Semaphore $self->{maxjobs} || 1;
   $self;
}

sub ip {
   $_[0]{ip};
}

sub sanitize {
   $_[1];
}

sub whois_request {
   my ($self, $query) = @_;

   my $id = "$self->{name}\x0$query";
   my $whois = $netgeo::whois{$id};

   unless (defined $whois) {
      print "WHOIS($self->{name},$query)\n";

      my $guard = $self->{maxjobs}->guard;
      my $timeout = 5;

      while () {
         my $fh = new Coro::Socket
                         PeerAddr => $self->ip,
                         PeerPort => $self->{port} || "whois",
                         Timeout  => 30;
         if ($fh) {
            print $fh "$query\n";
            $fh->read($whois, 16*1024); # max 16k. whois stored
            close $fh;
            $whois =~ s/\015?\012/\n/g;
            $whois = $self->sanitize($whois);
            if ($whois eq ""
                or ($whois =~ /query limit/i && $whois =~ /exceeded/i) # ARIN
                or ($whois =~ /wait a while and try again/i) # ARIN
                or ($whois =~ /^%ERROR:202:/) # RIPE/APNIC
            ) {
               print "retrying in $timeout seconds\n";#d#
               do_timer(desc => "timer2", after => $timeout);
               $timeout *= 2;
               $timeout = 1 if $timeout > 600;
            } else {
               last;
            }
         } else {
            # only retry once a minute
            print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n";
            Coro::Timer::sleep 300;
         }
      }

      $netgeo::whois{$id} = $whois;
   }

   $whois;
}

package Whois::ARIN;

use Date::Parse;

use base Whois;

sub sanitize {
   local $_ = $_[1];
   s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;
   $_;
}

# there are only two problems with arin's whois database:
# a) the data cannot be trusted and often is old or even wrong
# b) the database format is nonparsable
#    (no spaces between netname/ip and netnames can end in digits ;)
# of course, the only source to find out about global
# address distribution is... arin.
sub ip_request {
   my ($self, $ip) = @_;

   my $whois = $self->whois_request($ip);
   
   return if $whois =~ /^No match/;

   if ($whois =~ /^To single out one record/m) {
      my $handle;
      while ($whois =~ /\G\S.*\(([A-Z0-9\-]+)\).*\n/mg) {
         $handle = $1;
         #return if $handle =~ /-(RIPE|APNIC)/; # heuristic, but bad because ripe might not have better info
      }
      $handle or die "$whois ($ip): unparseable multimatch\n";
      $whois = $self->whois_request("!$handle");
   }

   return
     if $whois =~ /^OrgName:\s*RIPE Network Coordination Centre/mi;

   $whois =~ /^network:Network-Name:\s*(\S+)$/mi
      or $whois =~ /^NetName:\s*(\S+)$/mi
      or die "$whois($ip): no netname\n";
   my $netname = $1;

   $whois =~ /^network:IP-Network-Block:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/mi
      or $whois =~ /^NetRange:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/mi
      or die "$whois($ip): no netrange\n";
   my $netblock = $1;

   my $maintainer;

   if ($whois =~ /^Maintainer:\s*(\S+)\s*$/mi) {
      $maintainer = "*ma: $1\n";
      return if $1 =~ /^(?:AP|RIPE)$/;
   }

   $whois =~ /^Country:\s*(\S+)/mi
      or die "$whois($ip): no parseable country ($whois)\n";
   my $country = $1;

   $whois = <<EOF;
*in: $netblock
*na: $netname
*cy: $country

$whois
EOF

   $whois
}

package Whois::RIPE;

use Socket;
use base Whois;

sub sanitize {
   local $_ = $_[1];

   s/^%.*\n//gm;
   s/^\n+//;
   s/\n*$/\n/;

   s/^inetnum:\s+/*in: /gm;
   s/^admin-c:\s+/*ac: /gm;
   s/^tech-c:\s+/*tc: /gm;
   s/^owner-c:\s+/*oc: /gm;
   s/^country:\s+/*cy: /gm;
   s/^phone:\s+/*ph: /gm;
   s/^remarks:\s+/*rm: /gm;
   s/^changed:\s+/*ch: /gm;
   s/^created:\s+/*cr: /gm;
   s/^address:\s+/*ad: /gm;
   s/^status:\s+/*st: /gm;
   s/^inetrev:\s+/*ir: /gm;
   s/^nserver:\s+/*ns: /gm;

   $_;
}

sub ip_request {
   my ($self, $ip) = @_;

   my $whois = $self->whois_request("$self->{rflags}$ip");

   $whois =~ s{
      (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]+)
   }{
      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;
      (inet_ntoa $ip1) . " - " . (inet_ntoa $ip2);
   }gex;

   $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
      and return;

   $whois =~ /^\*na: ERX-NETBLOCK/m # ripe(?) 146.230.128.210
      and return;

   $whois =~ /^\*de: This network range is not allocated to /m # APNIC e.g. 24.0.0.0
      and return;

   $whois =~ /^\*de: Not allocated by APNIC/m # APNIC e.g. 189.47.24.97
      and return;

   $whois =~ /^\*ac: XXX0/m # 192.0.0.0
      and return;

   $whois =~ /^\*st: (?:ALLOCATED )?UNSPECIFIED/m
      and return;

   $whois =~ /^%ERROR:/m
      and return;

   #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) {
   #   $whois .= $self->whois_request("-FSTpn $1");
   #}

   #$whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg;

   $whois =~ s/\n+$//;

   $whois;
}

package Whois::RWHOIS;

use base Whois;

sub sanitize {
   local $_ = $_[1];
   s/^%referral\s+/referral:/gm;
   s/^network://gm;
   s/^%.*\n//gm;
   s/^\n+//m;
   s/\n*$/\n/m;

   s/^(\S+):\s*/\L$1: /gm;
   s/^ip-network-block:/*in:/gm;
   s/^country-code:/*cy:/gm;
   s/^tech-contact;i:/*tc:/gm;
   s/^updated:/*ch:/gm;
   s/^street-address:/*ad:/gm;
   s/^org-name:/*rm:/gm;
   s/^created:/*cr:/gm;

   $_;
}

sub ip_request {
   my ($self, $ip) = @_;

   my $whois = $self->whois_request("$ip");

   $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
      and return;

   $whois =~  /^\*ac: XXX0/m # 192.0.0.0
      and return;

   $whois =~ /^%ERROR:/m
      and return;

   #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) {
   #   $whois .= $self->whois_request("-FSTpn $1");
   #}

   $whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg;

   $whois =~ s/\n+$//;

   $whois;
}

package netgeo;

use Socket;
use BerkeleyDB;

sub ip2int($) {
   unpack "N", inet_aton $_[0];
}

sub int2ip($) {
   inet_ntoa pack "N", $_[0];
}

our %WHOIS;

#$WHOIS{ARIN}    = new Whois::ARIN ARIN  => "whois.arin.net",    port =>   43, maxjobs => 12;
$WHOIS{ARIN}    = new Whois::RWHOIS ARIN   => "rwhois.arin.net",   port => 4321, maxjobs => 1;
$WHOIS{RIPE}    = new Whois::RIPE RIPE     => "whois.ripe.net",    port =>   43, rflags => "-FTin ", maxjobs => 1;
$WHOIS{AFRINIC} = new Whois::RIPE AFRINIC  => "whois.afrinic.net", port =>   43, rflags => "-FTin ", maxjobs => 1;
$WHOIS{APNIC}   = new Whois::RIPE APNIC    => "whois.apnic.net",   port =>   43, rflags => "-FTin ", maxjobs => 1;
$WHOIS{LACNIC}  = new Whois::RIPE LACNIC   => "whois.lacnic.net",  port =>   43, maxjobs => 1;

$whoislock = new Coro::SemaphoreSet;

sub ip_request {
   my $ip = $_[0];

   my $guard = $whoislock->guard($ip);

   my $c = $iprange->db_cursor;
   my $v;

   if (!$c->c_get((inet_aton $ip), $v, DB_SET_RANGE)) {
      my ($ip0, $ip1, $whois) = split /\x0/, $v;
      my $_ip = ip2int $ip;
      if ($ip0 <= $_ip && $_ip <= $ip1) {
         return $whois;
      }
   }

   my ($arin, $ripe, $apnic);

   $whois = $WHOIS{RIPE}    ->ip_request ($ip)
         || $WHOIS{APNIC}   ->ip_request ($ip)
         || $WHOIS{AFRINIC} ->ip_request ($ip)
         || $WHOIS{LACNIC}  ->ip_request ($ip)
         || $WHOIS{ARIN}    ->ip_request ($ip)
         ;

   $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
      or do {
         warn "$whois($ip): no addresses found\n";
         return <<EOF;
*in: $ip-$ip
*na: whois failure
*cy: XX
EOF
      };

   my ($ip0, $ip1) = ($1, $2);

   my $_ip  = ip2int($ip);
   my $_ip0 = ip2int($ip0);
   my $_ip1 = ip2int($ip1);

   if ($_ip0 + 256 < $_ip1) {
      $_ip  = $_ip & 0xffffff00;
      $_ip0 = $_ip       if $_ip0 < $_ip;
      $_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
   }

   $iprange->db_put((pack "N", $_ip1), (join "\x0", $_ip0, $_ip1, $whois));
   (tied %whois)->db_sync;
   $iprange->db_sync;

   $whois
}

sub clear_cache() {
   %netgeo::whois = ();
   $netgeo::iprange->truncate (my $dummy);
}

if (1) {
   #print ip_request "68.52.164.8"; # goof
   #print "\n\n";
   print ip_request "200.202.220.222"; # lacnic
   print "\n\n";
   #print ip_request "62.116.167.250";
   #print "\n\n";
   #print ip_request "133.11.128.254"; # jp
   #print "\n\n";
#   print ip_request "76.6.7.8";
#   print "\n\n";
}

1;


Revision:	1.21
Committed:	Thu Feb 4 22:35:47 2010 UTC (14 years, 5 months ago) by root
Content type:	text/plain
Branch:	MAIN
Changes since 1.20:	+33 -29 lines
Log Message:	doh
#	User	Rev	Content
1	root	1.1	#!/usr/bin/perl
2
3			# APNIC refer: KRNIC (for 211.104.0.0)
4
5			use Socket;
6			use Fcntl;
7
8			use Coro;
9	root	1.18	use Coro::EV;
10	root	1.1	use Coro::Semaphore;
11	root	1.6	use Coro::SemaphoreSet;
12	root	1.1	use Coro::Socket;
13	root	1.13	use Coro::Timer;
14	root	1.1
15	root	1.7	use BerkeleyDB;
16
17	root	1.4	tie %netgeo::whois, BerkeleyDB::Btree,
18			-Env => $db_env,
19			-Filename => "whois",
20			-Flags => DB_CREATE,
21			or die "unable to create/open whois table";
22			$netgeo::iprange = new BerkeleyDB::Btree
23			-Env => $db_env,
24			-Filename => "iprange",
25			-Flags => DB_CREATE,
26			or die "unable to create/open iprange table";
27
28	root	1.1	package Whois;
29
30	root	1.18	use Coro::EV;
31	root	1.1
32			sub new {
33			my $class = shift;
34			my $name = shift;
35			my $ip = shift;
36			my $self = bless { name => $name, ip => $ip, @_ }, $class;
37			$self->{maxjobs} = new Coro::Semaphore $self->{maxjobs} \|\| 1;
38			$self;
39			}
40
41			sub ip {
42			$_[0]{ip};
43			}
44
45			sub sanitize {
46			$_[1];
47			}
48
49			sub whois_request {
50			my ($self, $query) = @_;
51
52	root	1.4	my $id = "$self->{name}\x0$query";
53			my $whois = $netgeo::whois{$id};
54
55			unless (defined $whois) {
56			print "WHOIS($self->{name},$query)\n";
57	root	1.1
58			my $guard = $self->{maxjobs}->guard;
59			my $timeout = 5;
60
61			while () {
62			my $fh = new Coro::Socket
63			PeerAddr => $self->ip,
64	root	1.10	PeerPort => $self->{port} \|\| "whois",
65	root	1.1	Timeout => 30;
66			if ($fh) {
67			print $fh "$query\n";
68			$fh->read($whois, 16*1024); # max 16k. whois stored
69			close $fh;
70			$whois =~ s/\015?\012/\n/g;
71			$whois = $self->sanitize($whois);
72			if ($whois eq ""
73			or ($whois =~ /query limit/i && $whois =~ /exceeded/i) # ARIN
74			or ($whois =~ /wait a while and try again/i) # ARIN
75			or ($whois =~ /^%ERROR:202:/) # RIPE/APNIC
76			) {
77			print "retrying in $timeout seconds\n";#d#
78			do_timer(desc => "timer2", after => $timeout);
79			$timeout *= 2;
80			$timeout = 1 if $timeout > 600;
81			} else {
82			last;
83			}
84	root	1.13	} else {
85			# only retry once a minute
86			print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n";
87	root	1.14	Coro::Timer::sleep 300;
88	root	1.1	}
89			}
90
91	root	1.4	$netgeo::whois{$id} = $whois;
92	root	1.1	}
93
94			$whois;
95			}
96
97			package Whois::ARIN;
98
99			use Date::Parse;
100
101			use base Whois;
102
103			sub sanitize {
104			local $_ = $_[1];
105			s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;
106			$_;
107			}
108
109			# there are only two problems with arin's whois database:
110			# a) the data cannot be trusted and often is old or even wrong
111			# b) the database format is nonparsable
112			# (no spaces between netname/ip and netnames can end in digits ;)
113			# of course, the only source to find out about global
114			# address distribution is... arin.
115			sub ip_request {
116			my ($self, $ip) = @_;
117
118			my $whois = $self->whois_request($ip);
119
120	root	1.16	return if $whois =~ /^No match/;
121	root	1.1
122			if ($whois =~ /^To single out one record/m) {
123			my $handle;
124			while ($whois =~ /\G\S.\(([A-Z0-9\-]+)\).\n/mg) {
125			$handle = $1;
126	root	1.16	#return if $handle =~ /-(RIPE\|APNIC)/; # heuristic, but bad because ripe might not have better info
127	root	1.1	}
128			$handle or die "$whois ($ip): unparseable multimatch\n";
129			$whois = $self->whois_request("!$handle");
130			}
131
132	root	1.21	return
133			if $whois =~ /^OrgName:\s*RIPE Network Coordination Centre/mi;
134	root	1.1
135	root	1.21	$whois =~ /^network:Network-Name:\s*(\S+)$/mi
136			or $whois =~ /^NetName:\s*(\S+)$/mi
137	root	1.1	or die "$whois($ip): no netname\n";
138			my $netname = $1;
139
140	root	1.21	$whois =~ /^network:IP-Network-Block:\s([0-9.]+\s-\s[0-9.]+)\s$/mi
141			or $whois =~ /^NetRange:\s([0-9.]+\s-\s[0-9.]+)\s$/mi
142			or die "$whois($ip): no netrange\n";
143	root	1.1	my $netblock = $1;
144
145			my $maintainer;
146
147	root	1.21	if ($whois =~ /^Maintainer:\s(\S+)\s$/mi) {
148	root	1.1	$maintainer = "*ma: $1\n";
149			return if $1 =~ /^(?:AP\|RIPE)$/;
150			}
151
152	root	1.21	$whois =~ /^Country:\s*(\S+)/mi
153			or die "$whois($ip): no parseable country ($whois)\n";
154	root	1.1	my $country = $1;
155
156			$whois = <<EOF;
157			*in: $netblock
158			*na: $netname
159			*cy: $country
160	root	1.21
161			$whois
162	root	1.1	EOF
163	root	1.21
164			$whois
165	root	1.1	}
166
167			package Whois::RIPE;
168
169	root	1.10	use Socket;
170	root	1.1	use base Whois;
171
172			sub sanitize {
173			local $_ = $_[1];
174	root	1.10
175	root	1.1	s/^%.*\n//gm;
176			s/^\n+//;
177			s/\n*$/\n/;
178	root	1.10
179			s/^inetnum:\s+/*in: /gm;
180			s/^admin-c:\s+/*ac: /gm;
181			s/^tech-c:\s+/*tc: /gm;
182			s/^owner-c:\s+/*oc: /gm;
183			s/^country:\s+/*cy: /gm;
184			s/^phone:\s+/*ph: /gm;
185	root	1.12	s/^remarks:\s+/*rm: /gm;
186	root	1.10	s/^changed:\s+/*ch: /gm;
187			s/^created:\s+/*cr: /gm;
188			s/^address:\s+/*ad: /gm;
189			s/^status:\s+/*st: /gm;
190			s/^inetrev:\s+/*ir: /gm;
191			s/^nserver:\s+/*ns: /gm;
192
193			$_;
194			}
195
196			sub ip_request {
197			my ($self, $ip) = @_;
198
199			my $whois = $self->whois_request("$self->{rflags}$ip");
200
201			$whois =~ s{
202			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
203			(?:\.
204			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
205			(?:\.
206			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
207			(?:\.
208			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
209			)?
210			)?
211			)?
212			/
213			([0-9]+)
214			}{
215			my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4;
216			my $net = 1 << (31 - $5);
217			my $mask = inet_aton 2 ** 32 - $net;
218
219			my $ip1 = $ip & $mask;
220			my $ip2 = $ip1 \| inet_aton $net * 2 - 1;
221			(inet_ntoa $ip1) . " - " . (inet_ntoa $ip2);
222			}gex;
223
224			$whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
225			and return;
226
227	root	1.20	$whois =~ /^\*na: ERX-NETBLOCK/m # ripe(?) 146.230.128.210
228			and return;
229
230			$whois =~ /^\*de: This network range is not allocated to /m # APNIC e.g. 24.0.0.0
231	root	1.17	and return;
232
233	root	1.20	$whois =~ /^\*de: Not allocated by APNIC/m # APNIC e.g. 189.47.24.97
234	root	1.19	and return;
235
236	root	1.10	$whois =~ /^\*ac: XXX0/m # 192.0.0.0
237			and return;
238
239			$whois =~ /^\*st: (?:ALLOCATED )?UNSPECIFIED/m
240			and return;
241
242			$whois =~ /^%ERROR:/m
243			and return;
244
245			#while ($whois =~ s/^\*(?:ac\|tc):\s+(\S+)\n//m) {
246			# $whois .= $self->whois_request("-FSTpn $1");
247			#}
248
249			#$whois =~ s/^\(?:pn\|nh\|mb\|ch\|so\|rz\|ny\|st\|rm):.\n//mg;
250
251			$whois =~ s/\n+$//;
252
253			$whois;
254			}
255
256			package Whois::RWHOIS;
257
258			use base Whois;
259
260			sub sanitize {
261			local $_ = $_[1];
262			s/^%referral\s+/referral:/gm;
263			s/^network://gm;
264			s/^%.*\n//gm;
265			s/^\n+//m;
266			s/\n*$/\n/m;
267
268			s/^(\S+):\s*/\L$1: /gm;
269			s/^ip-network-block:/*in:/gm;
270			s/^country-code:/*cy:/gm;
271			s/^tech-contact;i:/*tc:/gm;
272			s/^updated:/*ch:/gm;
273			s/^street-address:/*ad:/gm;
274	root	1.12	s/^org-name:/*rm:/gm;
275	root	1.10	s/^created:/*cr:/gm;
276
277	root	1.1	$_;
278			}
279
280			sub ip_request {
281			my ($self, $ip) = @_;
282
283	root	1.10	my $whois = $self->whois_request("$ip");
284	root	1.1
285			$whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
286			and return;
287
288			$whois =~ /^\*ac: XXX0/m # 192.0.0.0
289			and return;
290
291			$whois =~ /^%ERROR:/m
292			and return;
293
294			#while ($whois =~ s/^\*(?:ac\|tc):\s+(\S+)\n//m) {
295			# $whois .= $self->whois_request("-FSTpn $1");
296			#}
297
298			$whois =~ s/^\(?:pn\|nh\|mb\|ch\|so\|rz\|ny\|st\|rm):.\n//mg;
299
300			$whois =~ s/\n+$//;
301
302			$whois;
303			}
304
305	root	1.4	package netgeo;
306
307			use Socket;
308	root	1.8	use BerkeleyDB;
309	root	1.1
310			sub ip2int($) {
311			unpack "N", inet_aton $_[0];
312			}
313
314			sub int2ip($) {
315			inet_ntoa pack "N", $_[0];
316			}
317
318			our %WHOIS;
319
320	root	1.20	#$WHOIS{ARIN} = new Whois::ARIN ARIN => "whois.arin.net", port => 43, maxjobs => 12;
321			$WHOIS{ARIN} = new Whois::RWHOIS ARIN => "rwhois.arin.net", port => 4321, maxjobs => 1;
322			$WHOIS{RIPE} = new Whois::RIPE RIPE => "whois.ripe.net", port => 43, rflags => "-FTin ", maxjobs => 1;
323			$WHOIS{AFRINIC} = new Whois::RIPE AFRINIC => "whois.afrinic.net", port => 43, rflags => "-FTin ", maxjobs => 1;
324			$WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", port => 43, rflags => "-FTin ", maxjobs => 1;
325			$WHOIS{LACNIC} = new Whois::RIPE LACNIC => "whois.lacnic.net", port => 43, maxjobs => 1;
326	root	1.1
327	root	1.6	$whoislock = new Coro::SemaphoreSet;
328
329	root	1.1	sub ip_request {
330			my $ip = $_[0];
331	root	1.6
332			my $guard = $whoislock->guard($ip);
333	root	1.1
334	root	1.4	my $c = $iprange->db_cursor;
335			my $v;
336
337			if (!$c->c_get((inet_aton $ip), $v, DB_SET_RANGE)) {
338			my ($ip0, $ip1, $whois) = split /\x0/, $v;
339			my $_ip = ip2int $ip;
340			if ($ip0 <= $_ip && $_ip <= $ip1) {
341			return $whois;
342	root	1.1	}
343	root	1.4	}
344
345			my ($arin, $ripe, $apnic);
346
347	root	1.21	$whois = $WHOIS{RIPE} ->ip_request ($ip)
348			\|\| $WHOIS{APNIC} ->ip_request ($ip)
349			\|\| $WHOIS{AFRINIC} ->ip_request ($ip)
350			\|\| $WHOIS{LACNIC} ->ip_request ($ip)
351			\|\| $WHOIS{ARIN} ->ip_request ($ip)
352	root	1.10	;
353	root	1.1
354	root	1.4	$whois =~ /^\in: ([0-9.]+)\s+-\s+([0-9.]+)\s$/mi
355	root	1.21	or do {
356			warn "$whois($ip): no addresses found\n";
357			return <<EOF;
358			*in: $ip-$ip
359			*na: whois failure
360			*cy: XX
361			EOF
362			};
363	root	1.1
364	root	1.4	my ($ip0, $ip1) = ($1, $2);
365
366			my $_ip = ip2int($ip);
367			my $_ip0 = ip2int($ip0);
368			my $_ip1 = ip2int($ip1);
369
370			if ($_ip0 + 256 < $_ip1) {
371			$_ip = $_ip & 0xffffff00;
372			$_ip0 = $_ip if $_ip0 < $_ip;
373			$_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
374	root	1.1	}
375	root	1.4
376			$iprange->db_put((pack "N", $_ip1), (join "\x0", $_ip0, $_ip1, $whois));
377			(tied %whois)->db_sync;
378			$iprange->db_sync;
379	root	1.1
380	root	1.21	$whois
381	root	1.10	}
382
383	root	1.20	sub clear_cache() {
384			%netgeo::whois = ();
385			$netgeo::iprange->truncate (my $dummy);
386			}
387
388	root	1.21	if (1) {
389	root	1.10	#print ip_request "68.52.164.8"; # goof
390			#print "\n\n";
391	root	1.21	print ip_request "200.202.220.222"; # lacnic
392			print "\n\n";
393	root	1.10	#print ip_request "62.116.167.250";
394			#print "\n\n";
395			#print ip_request "133.11.128.254"; # jp
396			#print "\n\n";
397	root	1.21	# print ip_request "76.6.7.8";
398			# print "\n\n";
399	root	1.1	}
400
401	root	1.11	1;
402	root	1.1
403