ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/myhttpd/netgeo.pl
Revision: 1.18
Committed: Sat Dec 8 21:01:16 2007 UTC (16 years, 7 months ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: rel-4_91, rel-5_151, rel-5_1, rel-5_0, rel-4_748, rel-4_8, rel-4_9, rel-4_741, rel-4_743, rel-4_742, rel-4_744, rel-4_747, rel-6_13, rel-5_161, rel-4_74, rel-4_71, rel-4_72, rel-4_73, rel-5_162, rel-5_2, rel-4_802, rel-4_803, rel-4_801, rel-4_804, rel-4_479, rel-4_50, rel-4_51, rel-4_4, rel-4_45, rel-4_745, rel-4_901, rel-4_49, rel-4_48, rel-4_746, rel-5_11, rel-5_12, rel-5_15, rel-5_14, rel-5_17, rel-5_16, rel-4_47, rel-4_46, rel-4_7, rel-5_132, rel-5_131, rel-4_911, rel-4_912, rel-4_32, rel-4_33, rel-4_34, rel-4_35, rel-4_36, rel-4_37
Changes since 1.17: +2 -7 lines
Log Message:
convert from Event to EV

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 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     my ($address, $info, $coordinator, undef) = split /\n\n/, $whois;
133    
134     $info =~ /^\s+Netname: (\S+)$/mi
135     or die "$whois($ip): no netname\n";
136     my $netname = $1;
137    
138     $info =~ /^\s+Netblock: ([0-9.]+\s+-\s+[0-9.]+)\s*$/mi
139     or die "$whois($ip): no netblock\n";
140     my $netblock = $1;
141    
142     my $maintainer;
143    
144     if ($info =~ /^\s+Maintainer: (\S+)\s*$/mi) {
145     $maintainer = "*ma: $1\n";
146     return if $1 =~ /^(?:AP|RIPE)$/;
147     }
148    
149     $coordinator =~ s/^\s+Coordinator:\s*//si
150     or $coordinator = "";
151    
152     $address =~ s/\n\s*(\S+)$//
153     or die "$whois($ip): no parseable country ($address)\n";
154     my $country = $1;
155    
156     $address =~ s/^\s*/*de: /mg;
157     $coordinator =~ s/^\s*/*ad: /mg;
158    
159     $whois = <<EOF;
160     *in: $netblock
161     *na: $netname
162     *cy: $country
163     $maintainer$address
164     $coordinator
165     EOF
166     $whois =~ s/\n+$//;
167     $whois;
168     }
169    
170     package Whois::RIPE;
171    
172 root 1.10 use Socket;
173 root 1.1 use base Whois;
174    
175     sub sanitize {
176     local $_ = $_[1];
177 root 1.10
178 root 1.1 s/^%.*\n//gm;
179     s/^\n+//;
180     s/\n*$/\n/;
181 root 1.10
182     s/^inetnum:\s+/*in: /gm;
183     s/^admin-c:\s+/*ac: /gm;
184     s/^tech-c:\s+/*tc: /gm;
185     s/^owner-c:\s+/*oc: /gm;
186     s/^country:\s+/*cy: /gm;
187     s/^phone:\s+/*ph: /gm;
188 root 1.12 s/^remarks:\s+/*rm: /gm;
189 root 1.10 s/^changed:\s+/*ch: /gm;
190     s/^created:\s+/*cr: /gm;
191     s/^address:\s+/*ad: /gm;
192     s/^status:\s+/*st: /gm;
193     s/^inetrev:\s+/*ir: /gm;
194     s/^nserver:\s+/*ns: /gm;
195    
196     $_;
197     }
198    
199     sub ip_request {
200     my ($self, $ip) = @_;
201    
202     my $whois = $self->whois_request("$self->{rflags}$ip");
203    
204     $whois =~ s{
205     (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
206     (?:\.
207     (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
208     (?:\.
209     (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
210     (?:\.
211     (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
212     )?
213     )?
214     )?
215     /
216     ([0-9]+)
217     }{
218     my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4;
219     my $net = 1 << (31 - $5);
220     my $mask = inet_aton 2 ** 32 - $net;
221    
222     my $ip1 = $ip & $mask;
223     my $ip2 = $ip1 | inet_aton $net * 2 - 1;
224     (inet_ntoa $ip1) . " - " . (inet_ntoa $ip2);
225     }gex;
226    
227     $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
228     and return;
229    
230 root 1.17 $whois =~ /^\*de: This network range is not allocated to /m # APINIC e.g. 24.0.0.0
231     and return;
232    
233 root 1.10 $whois =~ /^\*ac: XXX0/m # 192.0.0.0
234     and return;
235    
236     $whois =~ /^\*st: (?:ALLOCATED )?UNSPECIFIED/m
237     and return;
238    
239     $whois =~ /^%ERROR:/m
240     and return;
241    
242     #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) {
243     # $whois .= $self->whois_request("-FSTpn $1");
244     #}
245    
246     #$whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg;
247    
248     $whois =~ s/\n+$//;
249    
250     $whois;
251     }
252    
253     package Whois::RWHOIS;
254    
255     use base Whois;
256    
257     sub sanitize {
258     local $_ = $_[1];
259     s/^%referral\s+/referral:/gm;
260     s/^network://gm;
261     s/^%.*\n//gm;
262     s/^\n+//m;
263     s/\n*$/\n/m;
264    
265     s/^(\S+):\s*/\L$1: /gm;
266     s/^ip-network-block:/*in:/gm;
267     s/^country-code:/*cy:/gm;
268     s/^tech-contact;i:/*tc:/gm;
269     s/^updated:/*ch:/gm;
270     s/^street-address:/*ad:/gm;
271 root 1.12 s/^org-name:/*rm:/gm;
272 root 1.10 s/^created:/*cr:/gm;
273    
274 root 1.1 $_;
275     }
276    
277     sub ip_request {
278     my ($self, $ip) = @_;
279    
280 root 1.10 my $whois = $self->whois_request("$ip");
281 root 1.1
282     $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
283     and return;
284    
285     $whois =~ /^\*ac: XXX0/m # 192.0.0.0
286     and return;
287    
288     $whois =~ /^%ERROR:/m
289     and return;
290    
291     #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) {
292     # $whois .= $self->whois_request("-FSTpn $1");
293     #}
294    
295     $whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg;
296    
297     $whois =~ s/\n+$//;
298    
299     $whois;
300     }
301    
302 root 1.4 package netgeo;
303    
304     use Socket;
305 root 1.8 use BerkeleyDB;
306 root 1.1
307     sub ip2int($) {
308     unpack "N", inet_aton $_[0];
309     }
310    
311     sub int2ip($) {
312     inet_ntoa pack "N", $_[0];
313     }
314    
315     our %WHOIS;
316    
317 root 1.10 #$WHOIS{ARIN} = new Whois::ARIN ARIN => "whois.arin.net", port => 43, maxjobs => 12;
318     $WHOIS{ARIN} = new Whois::RWHOIS ARIN => "rwhois.arin.net", port => 4321, maxjobs => 12;
319 root 1.15 $WHOIS{RIPE} = new Whois::RIPE RIPE => "whois.ripe.net", port => 43, rflags => "-FTin ", maxjobs => 20;
320     $WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", port => 43, rflags => "-FTin ", maxjobs => 20;
321 root 1.10 $WHOIS{LACNIC} = new Whois::RIPE LACNIC => "whois.lacnic.net", port => 43, maxjobs => 20;
322 root 1.1
323 root 1.6 $whoislock = new Coro::SemaphoreSet;
324    
325 root 1.1 sub ip_request {
326     my $ip = $_[0];
327 root 1.6
328     my $guard = $whoislock->guard($ip);
329 root 1.1
330 root 1.4 my $c = $iprange->db_cursor;
331     my $v;
332    
333     if (!$c->c_get((inet_aton $ip), $v, DB_SET_RANGE)) {
334     my ($ip0, $ip1, $whois) = split /\x0/, $v;
335     my $_ip = ip2int $ip;
336     if ($ip0 <= $_ip && $_ip <= $ip1) {
337     return $whois;
338 root 1.1 }
339 root 1.4 }
340    
341     my ($arin, $ripe, $apnic);
342    
343 root 1.9 $whois = $WHOIS{RIPE}->ip_request($ip)
344 root 1.10 || $WHOIS{APNIC} ->ip_request($ip)
345 root 1.9 || $WHOIS{ARIN} ->ip_request($ip)
346 root 1.15 # || $WHOIS{LACNIC}->ip_request($ip)
347 root 1.10 ;
348 root 1.1
349 root 1.4 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
350     or do { warn "$whois($ip): no addresses found\n", last };
351 root 1.1
352 root 1.4 my ($ip0, $ip1) = ($1, $2);
353    
354     my $_ip = ip2int($ip);
355     my $_ip0 = ip2int($ip0);
356     my $_ip1 = ip2int($ip1);
357    
358     if ($_ip0 + 256 < $_ip1) {
359     $_ip = $_ip & 0xffffff00;
360     $_ip0 = $_ip if $_ip0 < $_ip;
361     $_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
362 root 1.1 }
363 root 1.4
364     $iprange->db_put((pack "N", $_ip1), (join "\x0", $_ip0, $_ip1, $whois));
365     (tied %whois)->db_sync;
366     $iprange->db_sync;
367 root 1.1
368     $whois;
369 root 1.10 }
370    
371     if (0) {
372     #print ip_request "68.52.164.8"; # goof
373     #print "\n\n";
374     #print ip_request "200.202.220.222"; # lacnic
375     #print "\n\n";
376     #print ip_request "62.116.167.250";
377     #print "\n\n";
378     #print ip_request "133.11.128.254"; # jp
379     #print "\n\n";
380 root 1.15 print ip_request "80.131.153.93";
381     print "\n\n";
382 root 1.1 }
383    
384 root 1.11 1;
385 root 1.1
386