ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/myhttpd/netgeo.pl
Revision: 1.17
Committed: Sat Sep 17 20:27:47 2005 UTC (18 years, 9 months ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: rel-2_5, rel-4_22, rel-4_21, rel-4_0, rel-4_3, rel-3_41, rel-4_13, rel-4_11, rel-3_55, rel-3_51, rel-4_01, rel-4_03, rel-4_02, rel-2_0, rel-2_1, rel-1_9, rel-3_6, rel-3_62, rel-3_63, rel-3_61, rel-1_5, rel-1_7, rel-1_6, rel-3_4, rel-3_1, rel-3_5, rel-3_3, rel-3_2, rel-3_0, rel-3_01, rel-3_11, rel-4_1, rel-4_2, stack_sharing, rel-3_501, rel-4_31
Changes since 1.16: +3 -1 lines
Log Message:
*** empty log message ***

File Contents

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