Coro/myhttpd/netgeo.pl

#!/usr/bin/perl

# APNIC refer: KRNIC (for 211.104.0.0)

use Socket;
use Fcntl;

use AnyEvent;
use Coro;
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 Socket;
use Coro::AnyEvent ();
use Date::Parse;

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 sanitize {
   local $_ = $_[0];

   s/\015?\012/\n/g;
   s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;

   $_
}

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

   my $id = "$self->{name}\x00$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
            undef $fh;

            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#

               Coro::AnyEvent::sleep $timeout;

               $timeout *= 3;
            } else {
               last;
            }
         } else {
            print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n";
            Coro::AnyEvent::sleep 60;
         }
      }

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

   $whois
}

sub mangle_rwhois {
   die "rwhois: RIPE delegation"
     if /^OrgName:\s*RIPE Network Coordination Centre/m;

   /^network:ID:\s*(.*)$/m
      or die "rwhois($_): no network ID";
   my $na = $1;

   /^network:IP-Network-Block:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/m
      or die "rwhois($_): no network block\n";
   my $in = $1;

   /^network:Country-Code:\s*(.*)/m
      or die "rwhois($_): no country code\n";
   my $cy = $1;

   $_ = <<EOF;
*in: $in
*na: $na
*cy: $cy

$_
EOF
}

sub mangle_arin {
   die "arin: RIPE delegation"
     if /^OrgName:\s*RIPE Network Coordination Centre/mi;

   /^NetName:\s*(.*)$/m
      or die "arin($_): no network name";
   my $na = $1;

   /^NetRange:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/m
      or die "arin($_): no network block\n";
   my $in = $1;

   /^Country:\s*(.*)/mi
      or die "arin($_): no country code\n";
   my $cy = $1;

   $_ = <<EOF;
*in: $in
*na: $na
*cy: $cy

$_
EOF
}

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

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

   s/^descr:  \s+/*de: /gmx;
   s/^person: \s+/*pe: /gmx;
   s/^e-mail: \s+/*em: /gmx;
   s/^owner:  \s+/*ow: /gmx;
   s/^source: \s+/*so: /gmx;
   s/^role:   \s+/*ro: /gmx;
   s/^nic-hdl:\s+/*hd: /gmx;
   s/^mnt-by: \s+/*mb: /gmx;
   s/^route:  \s+/*ru: /gmx;
   s/^origin: \s+/*og: /gmx;
   s/^netname:\s+/*nn: /gmx;
   s/^mnt-lower:\s+/*ml: /gmx;

   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;

   /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
      and die "whole internet";

   /^\*de: Various Registries/m # ripe 146.0.0.0
      and die;

   /^\*cy: .*is really world wide/m # ripe 146.0.0.0
      and die;

   /^\*de: This network range is not allocated to /m # APNIC e.g. 24.0.0.0
      and die;

   /^\*de: Not allocated by APNIC/m # APNIC e.g. 189.47.24.97
      and die;

   /^\*ac: XXX0/m # 192.0.0.0
      and die;

   /^\*st: (?:ALLOCATED )?UNSPECIFIED/m
      and die;

   /^%ERROR:/m
      and die;
}

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

   # detect format

   for ($whois) {
      if (/^inetnum:/m && /^country:/m) {
         mangle_ripe;
      } elsif (/^network:ID:/m && /^network:Country-Code:/m) {
         mangle_rwhois;
      } elsif (/^NetName:/m && /^Country:/m) {
         mangle_arin;
      } else {
         die "short arin format, error, garbage";
      }
   }

   $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    => "rwhois.arin.net",   port => 4321, maxjobs => 1;
$WHOIS{RIPE}    = new Whois RIPE    => "whois.ripe.net",    port =>   43, maxjobs => 1, rflags => "-FTin ";
$WHOIS{AFRINIC} = new Whois AFRINIC => "whois.afrinic.net", port =>   43, maxjobs => 1, rflags => "-FTin ";
$WHOIS{APNIC}   = new Whois APNIC   => "whois.apnic.net",   port =>   43, maxjobs => 1, rflags => "-FTin ";
$WHOIS{LACNIC}  = new Whois 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 = eval { $WHOIS{RIPE}    ->ip_request ($ip) }
         || eval { $WHOIS{APNIC}   ->ip_request ($ip) }
         || eval { $WHOIS{AFRINIC} ->ip_request ($ip) }
         || eval { $WHOIS{LACNIC}  ->ip_request ($ip) }
         || eval { $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 (0) {
   print ip_request "68.52.164.8"; # goof
   #print ip_request "200.202.220.222"; # lacnic
   #print ip_request "62.116.167.250";
   #print ip_request "133.11.128.254"; # jp
#   print ip_request "76.6.7.8";
}

1;


Revision:	1.22
Committed:	Fri Feb 5 00:36:45 2010 UTC (14 years, 5 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-6_0, rel-6_5, rel-6_10, rel-6_09, rel-6_08, rel-6_07, rel-6_06, rel-6_05, rel-6_04, rel-6_03, rel-6_02, rel-6_01, rel-5_371, rel-5_372, rel-6_512, rel-6_513, rel-6_511, rel-6_514, rel-5_22, rel-5_23, rel-5_24, rel-5_25, rel-6_32, rel-6_33, rel-6_31, rel-6_36, rel-6_37, rel-6_38, rel-6_39, rel-5_37, rel-5_36, rel-6_23, rel-6_29, rel-6_28, rel-6_46, rel-6_45, rel-6_51, rel-6_52, rel-6_53, rel-6_54, rel-6_55, rel-6_56, rel-6_57, rel-6_43, rel-6_42, rel-6_41, rel-6_47, rel-6_44, rel-6_49, rel-6_48, HEAD
Changes since 1.21:	+157 -151 lines
Log Message:	* empty log message *
#	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	root	1.22	use AnyEvent;
9	root	1.1	use Coro;
10			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.22	use Socket;
31			use Coro::AnyEvent ();
32			use Date::Parse;
33	root	1.1
34			sub new {
35			my $class = shift;
36			my $name = shift;
37			my $ip = shift;
38			my $self = bless { name => $name, ip => $ip, @_ }, $class;
39	root	1.22
40	root	1.1	$self->{maxjobs} = new Coro::Semaphore $self->{maxjobs} \|\| 1;
41
42	root	1.22	$self
43	root	1.1	}
44
45			sub sanitize {
46	root	1.22	local $_ = $_[0];
47
48			s/\015?\012/\n/g;
49			s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;
50
51			$_
52	root	1.1	}
53
54			sub whois_request {
55			my ($self, $query) = @_;
56
57	root	1.22	my $id = "$self->{name}\x00$query";
58	root	1.4	my $whois = $netgeo::whois{$id};
59
60			unless (defined $whois) {
61			print "WHOIS($self->{name},$query)\n";
62	root	1.1
63			my $guard = $self->{maxjobs}->guard;
64			my $timeout = 5;
65
66			while () {
67			my $fh = new Coro::Socket
68	root	1.22	PeerAddr => $self->{ip},
69	root	1.10	PeerPort => $self->{port} \|\| "whois",
70	root	1.1	Timeout => 30;
71	root	1.22
72	root	1.1	if ($fh) {
73			print $fh "$query\n";
74	root	1.22	$fh->read ($whois, 16*1024); # max 16k. whois stored
75			undef $fh;
76
77			sanitize $whois;
78
79	root	1.1	if ($whois eq ""
80			or ($whois =~ /query limit/i && $whois =~ /exceeded/i) # ARIN
81			or ($whois =~ /wait a while and try again/i) # ARIN
82			or ($whois =~ /^%ERROR:202:/) # RIPE/APNIC
83			) {
84			print "retrying in $timeout seconds\n";#d#
85	root	1.22
86			Coro::AnyEvent::sleep $timeout;
87
88			$timeout *= 3;
89	root	1.1	} else {
90			last;
91			}
92	root	1.13	} else {
93			print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n";
94	root	1.22	Coro::AnyEvent::sleep 60;
95	root	1.1	}
96			}
97
98	root	1.4	$netgeo::whois{$id} = $whois;
99	root	1.1	}
100
101	root	1.22	$whois
102	root	1.1	}
103
104	root	1.22	sub mangle_rwhois {
105			die "rwhois: RIPE delegation"
106			if /^OrgName:\s*RIPE Network Coordination Centre/m;
107
108			/^network:ID:\s(.)$/m
109			or die "rwhois($_): no network ID";
110			my $na = $1;
111
112			/^network:IP-Network-Block:\s([0-9.]+\s-\s[0-9.]+)\s$/m
113			or die "rwhois($_): no network block\n";
114			my $in = $1;
115
116			/^network:Country-Code:\s(.)/m
117			or die "rwhois($_): no country code\n";
118			my $cy = $1;
119
120			$_ = <<EOF;
121			*in: $in
122			*na: $na
123			*cy: $cy
124	root	1.1
125	root	1.22	$_
126			EOF
127	root	1.1	}
128
129	root	1.22	sub mangle_arin {
130			die "arin: RIPE delegation"
131			if /^OrgName:\s*RIPE Network Coordination Centre/mi;
132
133			/^NetName:\s(.)$/m
134			or die "arin($_): no network name";
135			my $na = $1;
136
137			/^NetRange:\s([0-9.]+\s-\s[0-9.]+)\s$/m
138			or die "arin($_): no network block\n";
139			my $in = $1;
140
141			/^Country:\s(.)/mi
142			or die "arin($_): no country code\n";
143			my $cy = $1;
144
145			$_ = <<EOF;
146			*in: $in
147			*na: $na
148			*cy: $cy
149	root	1.1
150	root	1.22	$_
151	root	1.1	EOF
152			}
153
154	root	1.22	sub mangle_ripe {
155	root	1.1	s/^%.*\n//gm;
156			s/^\n+//;
157			s/\n*$/\n/;
158	root	1.10
159	root	1.22	s/^inetnum:\s+/*in: /gmx;
160			s/^admin-c:\s+/*ac: /gmx;
161			s/^tech-c: \s+/*tc: /gmx;
162			s/^owner-c:\s+/*oc: /gmx;
163			s/^country:\s+/*cy: /gmx;
164			s/^phone: \s+/*ph: /gmx;
165			s/^remarks:\s+/*rm: /gmx;
166			s/^changed:\s+/*ch: /gmx;
167			s/^created:\s+/*cr: /gmx;
168			s/^address:\s+/*ad: /gmx;
169			s/^status: \s+/*st: /gmx;
170			s/^inetrev:\s+/*ir: /gmx;
171			s/^nserver:\s+/*ns: /gmx;
172
173			s/^descr: \s+/*de: /gmx;
174			s/^person: \s+/*pe: /gmx;
175			s/^e-mail: \s+/*em: /gmx;
176			s/^owner: \s+/*ow: /gmx;
177			s/^source: \s+/*so: /gmx;
178			s/^role: \s+/*ro: /gmx;
179			s/^nic-hdl:\s+/*hd: /gmx;
180			s/^mnt-by: \s+/*mb: /gmx;
181			s/^route: \s+/*ru: /gmx;
182			s/^origin: \s+/*og: /gmx;
183			s/^netname:\s+/*nn: /gmx;
184			s/^mnt-lower:\s+/*ml: /gmx;
185	root	1.10
186	root	1.22	s{
187	root	1.10	(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
188			(?:\.
189			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
190			(?:\.
191			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
192			(?:\.
193			(2[0-5][0-9]\|1[0-9][0-9]\|[1-9][0-9]\|[0-9])
194			)?
195			)?
196			)?
197			/
198			([0-9]+)
199			}{
200			my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4;
201			my $net = 1 << (31 - $5);
202			my $mask = inet_aton 2 ** 32 - $net;
203
204			my $ip1 = $ip & $mask;
205			my $ip2 = $ip1 \| inet_aton $net * 2 - 1;
206			(inet_ntoa $ip1) . " - " . (inet_ntoa $ip2);
207			}gex;
208
209	root	1.22	/^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
210			and die "whole internet";
211
212			/^\*de: Various Registries/m # ripe 146.0.0.0
213			and die;
214
215			/^\cy: .is really world wide/m # ripe 146.0.0.0
216			and die;
217
218			/^\*de: This network range is not allocated to /m # APNIC e.g. 24.0.0.0
219			and die;
220	root	1.10
221	root	1.22	/^\*de: Not allocated by APNIC/m # APNIC e.g. 189.47.24.97
222			and die;
223	root	1.20
224	root	1.22	/^\*ac: XXX0/m # 192.0.0.0
225			and die;
226	root	1.17
227	root	1.22	/^\*st: (?:ALLOCATED )?UNSPECIFIED/m
228			and die;
229	root	1.19
230	root	1.22	/^%ERROR:/m
231			and die;
232			}
233	root	1.10
234	root	1.22	sub ip_request {
235			my ($self, $ip) = @_;
236	root	1.10
237	root	1.22	my $whois = $self->whois_request ($ip);
238
239			return if $whois =~ /^No match/;
240	root	1.10
241	root	1.22	if ($whois =~ /^To single out one record/m) {
242			my $handle;
243			while ($whois =~ /\G\S.\(([A-Z0-9\-]+)\).\n/mg) {
244			$handle = $1;
245			#return if $handle =~ /-(RIPE\|APNIC)/; # heuristic, but bad because ripe might not have better info
246			}
247			$handle or die "$whois ($ip): unparseable multimatch\n";
248			$whois = $self->whois_request ("!$handle");
249			}
250	root	1.10
251	root	1.22	# detect format
252	root	1.10
253	root	1.22	for ($whois) {
254			if (/^inetnum:/m && /^country:/m) {
255			mangle_ripe;
256			} elsif (/^network:ID:/m && /^network:Country-Code:/m) {
257			mangle_rwhois;
258			} elsif (/^NetName:/m && /^Country:/m) {
259			mangle_arin;
260			} else {
261			die "short arin format, error, garbage";
262			}
263			}
264	root	1.10
265	root	1.22	$whois
266	root	1.10	}
267
268			package Whois::RWHOIS;
269
270			use base Whois;
271
272			sub sanitize {
273			local $_ = $_[1];
274			s/^%referral\s+/referral:/gm;
275			s/^network://gm;
276			s/^%.*\n//gm;
277			s/^\n+//m;
278			s/\n*$/\n/m;
279
280			s/^(\S+):\s*/\L$1: /gm;
281			s/^ip-network-block:/*in:/gm;
282			s/^country-code:/*cy:/gm;
283			s/^tech-contact;i:/*tc:/gm;
284			s/^updated:/*ch:/gm;
285			s/^street-address:/*ad:/gm;
286	root	1.12	s/^org-name:/*rm:/gm;
287	root	1.10	s/^created:/*cr:/gm;
288
289	root	1.1	$_;
290			}
291
292			sub ip_request {
293			my ($self, $ip) = @_;
294
295	root	1.10	my $whois = $self->whois_request("$ip");
296	root	1.1
297			$whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
298			and return;
299
300			$whois =~ /^\*ac: XXX0/m # 192.0.0.0
301			and return;
302
303			$whois =~ /^%ERROR:/m
304			and return;
305
306			#while ($whois =~ s/^\*(?:ac\|tc):\s+(\S+)\n//m) {
307			# $whois .= $self->whois_request("-FSTpn $1");
308			#}
309
310			$whois =~ s/^\(?:pn\|nh\|mb\|ch\|so\|rz\|ny\|st\|rm):.\n//mg;
311
312			$whois =~ s/\n+$//;
313
314			$whois;
315			}
316
317	root	1.4	package netgeo;
318
319			use Socket;
320	root	1.8	use BerkeleyDB;
321	root	1.1
322			sub ip2int($) {
323			unpack "N", inet_aton $_[0];
324			}
325
326			sub int2ip($) {
327			inet_ntoa pack "N", $_[0];
328			}
329
330			our %WHOIS;
331
332	root	1.22	$WHOIS{ARIN} = new Whois ARIN => "rwhois.arin.net", port => 4321, maxjobs => 1;
333			$WHOIS{RIPE} = new Whois RIPE => "whois.ripe.net", port => 43, maxjobs => 1, rflags => "-FTin ";
334			$WHOIS{AFRINIC} = new Whois AFRINIC => "whois.afrinic.net", port => 43, maxjobs => 1, rflags => "-FTin ";
335			$WHOIS{APNIC} = new Whois APNIC => "whois.apnic.net", port => 43, maxjobs => 1, rflags => "-FTin ";
336			$WHOIS{LACNIC} = new Whois LACNIC => "whois.lacnic.net", port => 43, maxjobs => 1;
337	root	1.1
338	root	1.6	$whoislock = new Coro::SemaphoreSet;
339
340	root	1.1	sub ip_request {
341			my $ip = $_[0];
342	root	1.6
343			my $guard = $whoislock->guard($ip);
344	root	1.1
345	root	1.4	my $c = $iprange->db_cursor;
346			my $v;
347
348			if (!$c->c_get((inet_aton $ip), $v, DB_SET_RANGE)) {
349			my ($ip0, $ip1, $whois) = split /\x0/, $v;
350			my $_ip = ip2int $ip;
351			if ($ip0 <= $_ip && $_ip <= $ip1) {
352			return $whois;
353	root	1.1	}
354	root	1.4	}
355
356			my ($arin, $ripe, $apnic);
357
358	root	1.22	$whois = eval { $WHOIS{RIPE} ->ip_request ($ip) }
359			\|\| eval { $WHOIS{APNIC} ->ip_request ($ip) }
360			\|\| eval { $WHOIS{AFRINIC} ->ip_request ($ip) }
361			\|\| eval { $WHOIS{LACNIC} ->ip_request ($ip) }
362			\|\| eval { $WHOIS{ARIN} ->ip_request ($ip) }
363	root	1.10	;
364	root	1.1
365	root	1.4	$whois =~ /^\in: ([0-9.]+)\s+-\s+([0-9.]+)\s$/mi
366	root	1.21	or do {
367			warn "$whois($ip): no addresses found\n";
368			return <<EOF;
369			*in: $ip-$ip
370			*na: whois failure
371			*cy: XX
372			EOF
373			};
374	root	1.1
375	root	1.4	my ($ip0, $ip1) = ($1, $2);
376
377			my $_ip = ip2int($ip);
378			my $_ip0 = ip2int($ip0);
379			my $_ip1 = ip2int($ip1);
380
381			if ($_ip0 + 256 < $_ip1) {
382			$_ip = $_ip & 0xffffff00;
383			$_ip0 = $_ip if $_ip0 < $_ip;
384			$_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
385	root	1.1	}
386	root	1.4
387			$iprange->db_put((pack "N", $_ip1), (join "\x0", $_ip0, $_ip1, $whois));
388			(tied %whois)->db_sync;
389			$iprange->db_sync;
390	root	1.1
391	root	1.21	$whois
392	root	1.10	}
393
394	root	1.20	sub clear_cache() {
395			%netgeo::whois = ();
396			$netgeo::iprange->truncate (my $dummy);
397			}
398
399	root	1.22	if (0) {
400			print ip_request "68.52.164.8"; # goof
401			#print ip_request "200.202.220.222"; # lacnic
402	root	1.10	#print ip_request "62.116.167.250";
403			#print ip_request "133.11.128.254"; # jp
404	root	1.21	# print ip_request "76.6.7.8";
405	root	1.1	}
406
407	root	1.11	1;
408	root	1.1
409