ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/myhttpd/netgeo.pl
(Generate patch)

Comparing Coro/myhttpd/netgeo.pl (file contents):
Revision 1.1 by root, Sat Aug 11 00:37:32 2001 UTC vs.
Revision 1.16 by root, Sat Sep 17 20:21:11 2005 UTC

… …
2 2
3# APNIC refer: KRNIC (for 211.104.0.0) 3# APNIC refer: KRNIC (for 211.104.0.0)
4 4
5use Socket; 5use Socket;
6use Fcntl; 6use Fcntl;
7
8use PApp::SQL;
9 7
10use Coro; 8use Coro;
11use Coro::Event; 9use Coro::Event;
12use Coro::Semaphore; 10use Coro::Semaphore;
11use Coro::SemaphoreSet;
13use Coro::Socket; 12use Coro::Socket;
13use Coro::Timer;
14
15use BerkeleyDB;
14 16
15$Event::DIED = sub { 17$Event::DIED = sub {
16 Event::verbose_exception_handler(@_); 18 Event::verbose_exception_handler(@_);
17 #Event::unloop_all(); 19 #Event::unloop_all();
18}; 20};
19 21
20$PApp::SQL::DBH = PApp::SQL::connect_cached __FILE__, "DBI:mysql:netgeo" or die; 22tie %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";
21 32
22package Whois; 33package Whois;
23 34
24use PApp::SQL;
25use Coro::Event; 35use Coro::Event;
26 36
27sub new { 37sub new {
28 my $class = shift; 38 my $class = shift;
29 my $name = shift; 39 my $name = shift;
… …
41 $_[1]; 51 $_[1];
42} 52}
43 53
44sub whois_request { 54sub whois_request {
45 my ($self, $query) = @_; 55 my ($self, $query) = @_;
46 my ($id, $whois);
47 56
48 my $st = sql_exec \($id, $whois), 57 my $id = "$self->{name}\x0$query";
49 "select id, whois from whois 58 my $whois = $netgeo::whois{$id};
50 where nic = ? and query = ?",
51 $self->{name}, $query;
52 59
53 Coro::cede; 60 unless (defined $whois) {
61 print "WHOIS($self->{name},$query)\n";
54 62
55 unless ($st->fetch) {
56 my $guard = $self->{maxjobs}->guard; 63 my $guard = $self->{maxjobs}->guard;
57 my $timeout = 5; 64 my $timeout = 5;
58 65
59 while () { 66 while () {
60 my $fh = new Coro::Socket 67 my $fh = new Coro::Socket
61 PeerAddr => $self->ip, 68 PeerAddr => $self->ip,
62 PeerPort => 'whois', 69 PeerPort => $self->{port} || "whois",
63 Timeout => 30; 70 Timeout => 30;
64 if ($fh) { 71 if ($fh) {
65 print $fh "$query\n"; 72 print $fh "$query\n";
66 $fh->read($whois, 16*1024); # max 16k. whois stored 73 $fh->read($whois, 16*1024); # max 16k. whois stored
67 close $fh; 74 close $fh;
… …
77 $timeout *= 2; 84 $timeout *= 2;
78 $timeout = 1 if $timeout > 600; 85 $timeout = 1 if $timeout > 600;
79 } else { 86 } else {
80 last; 87 last;
81 } 88 }
89 } else {
90 # only retry once a minute
91 print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n";
92 Coro::Timer::sleep 300;
82 } 93 }
83 } 94 }
84 95
85 sql_exec "replace into whois values (NULL,?,?,NULL,?,?)", 96 $netgeo::whois{$id} = $whois;
86 $self->{name}, $query, $whois, time;
87
88 my $st = sql_exec \$id,
89 "select id from whois
90 where nic = ? and query = ?",
91 $self->{name}, $query;
92 $st->fetch or die;
93 } 97 }
94 98
95 $whois; 99 $whois;
96} 100}
97 101
98package Whois::ARIN; 102package Whois::ARIN;
99 103
100use Date::Parse; 104use Date::Parse;
101use PApp::SQL;
102 105
103use base Whois; 106use base Whois;
104 107
105sub sanitize { 108sub sanitize {
106 local $_ = $_[1]; 109 local $_ = $_[1];
… …
117sub ip_request { 120sub ip_request {
118 my ($self, $ip) = @_; 121 my ($self, $ip) = @_;
119 122
120 my $whois = $self->whois_request($ip); 123 my $whois = $self->whois_request($ip);
121 124
122 return () if $whois =~ /^No match/; 125 return if $whois =~ /^No match/;
126 return if $whois =~ /^\*de: This network range is not allocated to /; # APINIC e.g. 24.0.0.0
123 127
124 if ($whois =~ /^To single out one record/m) { 128 if ($whois =~ /^To single out one record/m) {
125 my $handle; 129 my $handle;
126 while ($whois =~ /\G\S.*\(([A-Z0-9\-]+)\).*\n/mg) { 130 while ($whois =~ /\G\S.*\(([A-Z0-9\-]+)\).*\n/mg) {
127 $handle = $1; 131 $handle = $1;
128 #return if $handle =~ /-(RIPE|APNIC)/; # heuristic, bbut bad because ripe might not have better info 132 #return if $handle =~ /-(RIPE|APNIC)/; # heuristic, but bad because ripe might not have better info
129 } 133 }
130 $handle or die "$whois ($ip): unparseable multimatch\n"; 134 $handle or die "$whois ($ip): unparseable multimatch\n";
131 $whois = $self->whois_request("!$handle"); 135 $whois = $self->whois_request("!$handle");
132 } 136 }
133 137
… …
169 $whois; 173 $whois;
170} 174}
171 175
172package Whois::RIPE; 176package Whois::RIPE;
173 177
174use PApp::SQL; 178use Socket;
175
176use base Whois; 179use base Whois;
177 180
178sub sanitize { 181sub sanitize {
179 local $_ = $_[1]; 182 local $_ = $_[1];
183
180 s/^%.*\n//gm; 184 s/^%.*\n//gm;
181 s/^\n+//; 185 s/^\n+//;
182 s/\n*$/\n/; 186 s/\n*$/\n/;
187
188 s/^inetnum:\s+/*in: /gm;
189 s/^admin-c:\s+/*ac: /gm;
190 s/^tech-c:\s+/*tc: /gm;
191 s/^owner-c:\s+/*oc: /gm;
192 s/^country:\s+/*cy: /gm;
193 s/^phone:\s+/*ph: /gm;
194 s/^remarks:\s+/*rm: /gm;
195 s/^changed:\s+/*ch: /gm;
196 s/^created:\s+/*cr: /gm;
197 s/^address:\s+/*ad: /gm;
198 s/^status:\s+/*st: /gm;
199 s/^inetrev:\s+/*ir: /gm;
200 s/^nserver:\s+/*ns: /gm;
201
183 $_; 202 $_;
184} 203}
185 204
186sub ip_request { 205sub ip_request {
187 my ($self, $ip) = @_; 206 my ($self, $ip) = @_;
188 207
189 my $whois = $self->whois_request("-FSTin $ip"); 208 my $whois = $self->whois_request("$self->{rflags}$ip");
209
210 $whois =~ s{
211 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
212 (?:\.
213 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
214 (?:\.
215 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
216 (?:\.
217 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
218 )?
219 )?
220 )?
221 /
222 ([0-9]+)
223 }{
224 my $ip = inet_aton sprintf "%d.%d.%d.%d", $1, $2, $3, $4;
225 my $net = 1 << (31 - $5);
226 my $mask = inet_aton 2 ** 32 - $net;
227
228 my $ip1 = $ip & $mask;
229 my $ip2 = $ip1 | inet_aton $net * 2 - 1;
230 (inet_ntoa $ip1) . " - " . (inet_ntoa $ip2);
231 }gex;
190 232
191 $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/ 233 $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
192 and return; 234 and return;
193 235
194 $whois =~ /^\*ac: XXX0/m # 192.0.0.0 236 $whois =~ /^\*ac: XXX0/m # 192.0.0.0
237 and return;
238
239 $whois =~ /^\*st: (?:ALLOCATED )?UNSPECIFIED/m
195 and return; 240 and return;
196 241
197 $whois =~ /^%ERROR:/m 242 $whois =~ /^%ERROR:/m
198 and return; 243 and return;
199 244
200 #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) { 245 #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) {
201 # $whois .= $self->whois_request("-FSTpn $1"); 246 # $whois .= $self->whois_request("-FSTpn $1");
202 #} 247 #}
203 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
256package Whois::RWHOIS;
257
258use base Whois;
259
260sub 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 s/^org-name:/*rm:/gm;
275 s/^created:/*cr:/gm;
276
277 $_;
278}
279
280sub ip_request {
281 my ($self, $ip) = @_;
282
283 my $whois = $self->whois_request("$ip");
284
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
204 $whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg; 298 $whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg;
205 299
206 $whois =~ s/\n+$//; 300 $whois =~ s/\n+$//;
207 301
208 $whois; 302 $whois;
209} 303}
210 304
211package main; 305package netgeo;
306
307use Socket;
308use BerkeleyDB;
212 309
213sub ip2int($) { 310sub ip2int($) {
214 unpack "N", inet_aton $_[0]; 311 unpack "N", inet_aton $_[0];
215} 312}
216 313
… …
218 inet_ntoa pack "N", $_[0]; 315 inet_ntoa pack "N", $_[0];
219} 316}
220 317
221our %WHOIS; 318our %WHOIS;
222 319
223$WHOIS{ARIN} = new Whois::ARIN ARIN => "whois.arin.net", maxjobs => 12; 320#$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 => 12;
224$WHOIS{RIPE} = new Whois::RIPE RIPE => "whois.ripe.net", maxjobs => 20; 322$WHOIS{RIPE} = new Whois::RIPE RIPE => "whois.ripe.net", port => 43, rflags => "-FTin ", maxjobs => 20;
323$WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", port => 43, rflags => "-FTin ", maxjobs => 20;
225$WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", maxjobs => 20; 324$WHOIS{LACNIC} = new Whois::RIPE LACNIC => "whois.lacnic.net", port => 43, maxjobs => 20;
325
326$whoislock = new Coro::SemaphoreSet;
226 327
227sub ip_request { 328sub ip_request {
228 my $ip = $_[0]; 329 my $ip = $_[0];
229 my $_ip = ip2int($ip);
230 330
231 my $st = sql_exec \my($whois, $ip0), 331 my $guard = $whoislock->guard($ip);
232 "select data, ip0 from iprange
233 where ? <= ip1
234 having ip0 <= ?
235 order by ip1
236 limit 1",
237 $_ip, $_ip;
238 332
239 Coro::cede; 333 my $c = $iprange->db_cursor;
240 334 my $v;
241 unless ($st->fetch) {
242 my ($arin, $ripe, $apnic);
243 335
244 $whois = $WHOIS{APNIC}->ip_request($ip) 336 if (!$c->c_get((inet_aton $ip), $v, DB_SET_RANGE)) {
245 || $WHOIS{RIPE} ->ip_request($ip) 337 my ($ip0, $ip1, $whois) = split /\x0/, $v;
246 || $WHOIS{ARIN} ->ip_request($ip);
247
248 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
249 or warn "$whois($ip): no addresses found\n";
250 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
251 or return;
252
253 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
254 or die "$whois($ip): no addresses found\n";
255
256 my ($ip0, $ip1) = ($1, $2);
257
258 my $_ip0 = ip2int($ip0); 338 my $_ip = ip2int $ip;
259 my $_ip1 = ip2int($ip1); 339 if ($ip0 <= $_ip && $_ip <= $ip1) {
260 340 return $whois;
261 if ($_ip0 + 256 < $_ip1) {
262 $_ip = $_ip & 0xffffff00;
263 $_ip0 = $_ip if $_ip0 < $_ip;
264 $_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
265 } 341 }
266
267 sql_exec "replace into iprange values (?, ?, NULL, ?)",
268 $_ip0, $_ip1, $whois;
269
270 #print "$ip ($ip0, $ip1 ($_ip0, $_ip1)\n$whois\n";
271 } 342 }
272 343
273 $whois; 344 my ($arin, $ripe, $apnic);
274}
275 345
346 $whois = $WHOIS{RIPE}->ip_request($ip)
347 || $WHOIS{APNIC} ->ip_request($ip)
348 || $WHOIS{ARIN} ->ip_request($ip)
349# || $WHOIS{LACNIC}->ip_request($ip)
350 ;
276 351
352 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
353 or do { warn "$whois($ip): no addresses found\n", last };
277 354
355 my ($ip0, $ip1) = ($1, $2);
356
357 my $_ip = ip2int($ip);
358 my $_ip0 = ip2int($ip0);
359 my $_ip1 = ip2int($ip1);
360
361 if ($_ip0 + 256 < $_ip1) {
362 $_ip = $_ip & 0xffffff00;
363 $_ip0 = $_ip if $_ip0 < $_ip;
364 $_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
365 }
366
367 $iprange->db_put((pack "N", $_ip1), (join "\x0", $_ip0, $_ip1, $whois));
368 (tied %whois)->db_sync;
369 $iprange->db_sync;
370
371 $whois;
372}
373
374if (0) {
375 #print ip_request "68.52.164.8"; # goof
376 #print "\n\n";
377 #print ip_request "200.202.220.222"; # lacnic
378 #print "\n\n";
379 #print ip_request "62.116.167.250";
380 #print "\n\n";
381 #print ip_request "133.11.128.254"; # jp
382 #print "\n\n";
383 print ip_request "80.131.153.93";
384 print "\n\n";
385}
386
3871;
388
389

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines