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.21 by root, Thu Feb 4 22:35:47 2010 UTC vs.
Revision 1.22 by root, Fri Feb 5 00:36:45 2010 UTC

… …
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 7
8use AnyEvent;
8use Coro; 9use Coro;
9use Coro::EV;
10use Coro::Semaphore; 10use Coro::Semaphore;
11use Coro::SemaphoreSet; 11use Coro::SemaphoreSet;
12use Coro::Socket; 12use Coro::Socket;
13use Coro::Timer; 13use Coro::Timer;
14 14
… …
25 -Flags => DB_CREATE, 25 -Flags => DB_CREATE,
26 or die "unable to create/open iprange table"; 26 or die "unable to create/open iprange table";
27 27
28package Whois; 28package Whois;
29 29
30use Coro::EV; 30use Socket;
31use Coro::AnyEvent ();
32use Date::Parse;
31 33
32sub new { 34sub new {
33 my $class = shift; 35 my $class = shift;
34 my $name = shift; 36 my $name = shift;
35 my $ip = shift; 37 my $ip = shift;
36 my $self = bless { name => $name, ip => $ip, @_ }, $class; 38 my $self = bless { name => $name, ip => $ip, @_ }, $class;
39
37 $self->{maxjobs} = new Coro::Semaphore $self->{maxjobs} || 1; 40 $self->{maxjobs} = new Coro::Semaphore $self->{maxjobs} || 1;
41
38 $self; 42 $self
39}
40
41sub ip {
42 $_[0]{ip};
43} 43}
44 44
45sub sanitize { 45sub sanitize {
46 $_[1]; 46 local $_ = $_[0];
47
48 s/\015?\012/\n/g;
49 s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;
50
51 $_
47} 52}
48 53
49sub whois_request { 54sub whois_request {
50 my ($self, $query) = @_; 55 my ($self, $query) = @_;
51 56
52 my $id = "$self->{name}\x0$query"; 57 my $id = "$self->{name}\x00$query";
53 my $whois = $netgeo::whois{$id}; 58 my $whois = $netgeo::whois{$id};
54 59
55 unless (defined $whois) { 60 unless (defined $whois) {
56 print "WHOIS($self->{name},$query)\n"; 61 print "WHOIS($self->{name},$query)\n";
57 62
58 my $guard = $self->{maxjobs}->guard; 63 my $guard = $self->{maxjobs}->guard;
59 my $timeout = 5; 64 my $timeout = 5;
60 65
61 while () { 66 while () {
62 my $fh = new Coro::Socket 67 my $fh = new Coro::Socket
63 PeerAddr => $self->ip, 68 PeerAddr => $self->{ip},
64 PeerPort => $self->{port} || "whois", 69 PeerPort => $self->{port} || "whois",
65 Timeout => 30; 70 Timeout => 30;
71
66 if ($fh) { 72 if ($fh) {
67 print $fh "$query\n"; 73 print $fh "$query\n";
68 $fh->read($whois, 16*1024); # max 16k. whois stored 74 $fh->read ($whois, 16*1024); # max 16k. whois stored
69 close $fh; 75 undef $fh;
70 $whois =~ s/\015?\012/\n/g; 76
71 $whois = $self->sanitize($whois); 77 sanitize $whois;
78
72 if ($whois eq "" 79 if ($whois eq ""
73 or ($whois =~ /query limit/i && $whois =~ /exceeded/i) # ARIN 80 or ($whois =~ /query limit/i && $whois =~ /exceeded/i) # ARIN
74 or ($whois =~ /wait a while and try again/i) # ARIN 81 or ($whois =~ /wait a while and try again/i) # ARIN
75 or ($whois =~ /^%ERROR:202:/) # RIPE/APNIC 82 or ($whois =~ /^%ERROR:202:/) # RIPE/APNIC
76 ) { 83 ) {
77 print "retrying in $timeout seconds\n";#d# 84 print "retrying in $timeout seconds\n";#d#
78 do_timer(desc => "timer2", after => $timeout); 85
86 Coro::AnyEvent::sleep $timeout;
87
79 $timeout *= 2; 88 $timeout *= 3;
80 $timeout = 1 if $timeout > 600;
81 } else { 89 } else {
82 last; 90 last;
83 } 91 }
84 } else { 92 } else {
85 # only retry once a minute
86 print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n"; 93 print STDERR "unable to connect to $self->{ip} ($self->{name}), retrying...\n";
87 Coro::Timer::sleep 300; 94 Coro::AnyEvent::sleep 60;
88 } 95 }
89 } 96 }
90 97
91 $netgeo::whois{$id} = $whois; 98 $netgeo::whois{$id} = $whois;
92 } 99 }
93 100
94 $whois; 101 $whois
95} 102}
96 103
97package Whois::ARIN; 104sub mangle_rwhois {
98 105 die "rwhois: RIPE delegation"
99use Date::Parse;
100
101use base Whois;
102
103sub 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.
115sub ip_request {
116 my ($self, $ip) = @_;
117
118 my $whois = $self->whois_request($ip);
119
120 return if $whois =~ /^No match/;
121
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 #return if $handle =~ /-(RIPE|APNIC)/; # heuristic, but bad because ripe might not have better info
127 }
128 $handle or die "$whois ($ip): unparseable multimatch\n";
129 $whois = $self->whois_request("!$handle");
130 }
131
132 return
133 if $whois =~ /^OrgName:\s*RIPE Network Coordination Centre/mi; 106 if /^OrgName:\s*RIPE Network Coordination Centre/m;
134 107
135 $whois =~ /^network:Network-Name:\s*(\S+)$/mi 108 /^network:ID:\s*(.*)$/m
136 or $whois =~ /^NetName:\s*(\S+)$/mi
137 or die "$whois($ip): no netname\n"; 109 or die "rwhois($_): no network ID";
138 my $netname = $1; 110 my $na = $1;
139 111
140 $whois =~ /^network:IP-Network-Block:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/mi 112 /^network:IP-Network-Block:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/m
141 or $whois =~ /^NetRange:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/mi 113 or die "rwhois($_): no network block\n";
114 my $in = $1;
115
116 /^network:Country-Code:\s*(.*)/m
142 or die "$whois($ip): no netrange\n"; 117 or die "rwhois($_): no country code\n";
143 my $netblock = $1;
144
145 my $maintainer;
146
147 if ($whois =~ /^Maintainer:\s*(\S+)\s*$/mi) {
148 $maintainer = "*ma: $1\n";
149 return if $1 =~ /^(?:AP|RIPE)$/;
150 }
151
152 $whois =~ /^Country:\s*(\S+)/mi
153 or die "$whois($ip): no parseable country ($whois)\n";
154 my $country = $1; 118 my $cy = $1;
155 119
156 $whois = <<EOF; 120 $_ = <<EOF;
157*in: $netblock 121*in: $in
158*na: $netname 122*na: $na
159*cy: $country 123*cy: $cy
160 124
161$whois 125$_
162EOF 126EOF
163
164 $whois
165} 127}
166 128
167package Whois::RIPE; 129sub mangle_arin {
130 die "arin: RIPE delegation"
131 if /^OrgName:\s*RIPE Network Coordination Centre/mi;
168 132
169use Socket; 133 /^NetName:\s*(.*)$/m
170use base Whois; 134 or die "arin($_): no network name";
135 my $na = $1;
171 136
172sub sanitize { 137 /^NetRange:\s*([0-9.]+\s*-\s*[0-9.]+)\s*$/m
173 local $_ = $_[1]; 138 or die "arin($_): no network block\n";
139 my $in = $1;
174 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
150$_
151EOF
152}
153
154sub mangle_ripe {
175 s/^%.*\n//gm; 155 s/^%.*\n//gm;
176 s/^\n+//; 156 s/^\n+//;
177 s/\n*$/\n/; 157 s/\n*$/\n/;
178 158
179 s/^inetnum:\s+/*in: /gm; 159 s/^inetnum:\s+/*in: /gmx;
180 s/^admin-c:\s+/*ac: /gm; 160 s/^admin-c:\s+/*ac: /gmx;
181 s/^tech-c:\s+/*tc: /gm; 161 s/^tech-c: \s+/*tc: /gmx;
182 s/^owner-c:\s+/*oc: /gm; 162 s/^owner-c:\s+/*oc: /gmx;
183 s/^country:\s+/*cy: /gm; 163 s/^country:\s+/*cy: /gmx;
184 s/^phone:\s+/*ph: /gm; 164 s/^phone: \s+/*ph: /gmx;
185 s/^remarks:\s+/*rm: /gm; 165 s/^remarks:\s+/*rm: /gmx;
186 s/^changed:\s+/*ch: /gm; 166 s/^changed:\s+/*ch: /gmx;
187 s/^created:\s+/*cr: /gm; 167 s/^created:\s+/*cr: /gmx;
188 s/^address:\s+/*ad: /gm; 168 s/^address:\s+/*ad: /gmx;
189 s/^status:\s+/*st: /gm; 169 s/^status: \s+/*st: /gmx;
190 s/^inetrev:\s+/*ir: /gm; 170 s/^inetrev:\s+/*ir: /gmx;
191 s/^nserver:\s+/*ns: /gm; 171 s/^nserver:\s+/*ns: /gmx;
192 172
193 $_; 173 s/^descr: \s+/*de: /gmx;
194} 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;
195 185
196sub ip_request { 186 s{
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]) 187 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
203 (?:\. 188 (?:\.
204 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) 189 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
205 (?:\. 190 (?:\.
206 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9]) 191 (2[0-5][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])
… …
219 my $ip1 = $ip & $mask; 204 my $ip1 = $ip & $mask;
220 my $ip2 = $ip1 | inet_aton $net * 2 - 1; 205 my $ip2 = $ip1 | inet_aton $net * 2 - 1;
221 (inet_ntoa $ip1) . " - " . (inet_ntoa $ip2); 206 (inet_ntoa $ip1) . " - " . (inet_ntoa $ip2);
222 }gex; 207 }gex;
223 208
224 $whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/ 209 /^\*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
225 and return; 213 and die;
226 214
227 $whois =~ /^\*na: ERX-NETBLOCK/m # ripe(?) 146.230.128.210 215 /^\*cy: .*is really world wide/m # ripe 146.0.0.0
228 and return; 216 and die;
229 217
230 $whois =~ /^\*de: This network range is not allocated to /m # APNIC e.g. 24.0.0.0 218 /^\*de: This network range is not allocated to /m # APNIC e.g. 24.0.0.0
231 and return; 219 and die;
232 220
233 $whois =~ /^\*de: Not allocated by APNIC/m # APNIC e.g. 189.47.24.97 221 /^\*de: Not allocated by APNIC/m # APNIC e.g. 189.47.24.97
234 and return; 222 and die;
235 223
236 $whois =~ /^\*ac: XXX0/m # 192.0.0.0 224 /^\*ac: XXX0/m # 192.0.0.0
237 and return; 225 and die;
238 226
239 $whois =~ /^\*st: (?:ALLOCATED )?UNSPECIFIED/m 227 /^\*st: (?:ALLOCATED )?UNSPECIFIED/m
240 and return; 228 and die;
241 229
242 $whois =~ /^%ERROR:/m 230 /^%ERROR:/m
243 and return; 231 and die;
232}
244 233
245 #while ($whois =~ s/^\*(?:ac|tc):\s+(\S+)\n//m) { 234sub ip_request {
235 my ($self, $ip) = @_;
236
237 my $whois = $self->whois_request ($ip);
238
239 return if $whois =~ /^No match/;
240
241 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";
246 # $whois .= $self->whois_request("-FSTpn $1"); 248 $whois = $self->whois_request ("!$handle");
247 #} 249 }
248 250
249 #$whois =~ s/^\*(?:pn|nh|mb|ch|so|rz|ny|st|rm):.*\n//mg; 251 # detect format
250 252
251 $whois =~ s/\n+$//; 253 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 }
252 264
253 $whois; 265 $whois
254} 266}
255 267
256package Whois::RWHOIS; 268package Whois::RWHOIS;
257 269
258use base Whois; 270use base Whois;
… …
315 inet_ntoa pack "N", $_[0]; 327 inet_ntoa pack "N", $_[0];
316} 328}
317 329
318our %WHOIS; 330our %WHOIS;
319 331
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 => 1; 332$WHOIS{ARIN} = new Whois ARIN => "rwhois.arin.net", port => 4321, maxjobs => 1;
322$WHOIS{RIPE} = new Whois::RIPE RIPE => "whois.ripe.net", port => 43, rflags => "-FTin ", maxjobs => 1; 333$WHOIS{RIPE} = new Whois RIPE => "whois.ripe.net", port => 43, maxjobs => 1, rflags => "-FTin ";
323$WHOIS{AFRINIC} = new Whois::RIPE AFRINIC => "whois.afrinic.net", port => 43, rflags => "-FTin ", maxjobs => 1; 334$WHOIS{AFRINIC} = new Whois AFRINIC => "whois.afrinic.net", port => 43, maxjobs => 1, rflags => "-FTin ";
324$WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", port => 43, rflags => "-FTin ", maxjobs => 1; 335$WHOIS{APNIC} = new Whois APNIC => "whois.apnic.net", port => 43, maxjobs => 1, rflags => "-FTin ";
325$WHOIS{LACNIC} = new Whois::RIPE LACNIC => "whois.lacnic.net", port => 43, maxjobs => 1; 336$WHOIS{LACNIC} = new Whois LACNIC => "whois.lacnic.net", port => 43, maxjobs => 1;
326 337
327$whoislock = new Coro::SemaphoreSet; 338$whoislock = new Coro::SemaphoreSet;
328 339
329sub ip_request { 340sub ip_request {
330 my $ip = $_[0]; 341 my $ip = $_[0];
… …
342 } 353 }
343 } 354 }
344 355
345 my ($arin, $ripe, $apnic); 356 my ($arin, $ripe, $apnic);
346 357
347 $whois = $WHOIS{RIPE} ->ip_request ($ip) 358 $whois = eval { $WHOIS{RIPE} ->ip_request ($ip) }
348 || $WHOIS{APNIC} ->ip_request ($ip) 359 || eval { $WHOIS{APNIC} ->ip_request ($ip) }
349 || $WHOIS{AFRINIC} ->ip_request ($ip) 360 || eval { $WHOIS{AFRINIC} ->ip_request ($ip) }
350 || $WHOIS{LACNIC} ->ip_request ($ip) 361 || eval { $WHOIS{LACNIC} ->ip_request ($ip) }
351 || $WHOIS{ARIN} ->ip_request ($ip) 362 || eval { $WHOIS{ARIN} ->ip_request ($ip) }
352 ; 363 ;
353 364
354 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi 365 $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
355 or do { 366 or do {
356 warn "$whois($ip): no addresses found\n"; 367 warn "$whois($ip): no addresses found\n";
… …
383sub clear_cache() { 394sub clear_cache() {
384 %netgeo::whois = (); 395 %netgeo::whois = ();
385 $netgeo::iprange->truncate (my $dummy); 396 $netgeo::iprange->truncate (my $dummy);
386} 397}
387 398
388if (1) { 399if (0) {
389 #print ip_request "68.52.164.8"; # goof 400 print ip_request "68.52.164.8"; # goof
390 #print "\n\n";
391 print ip_request "200.202.220.222"; # lacnic 401 #print ip_request "200.202.220.222"; # lacnic
392 print "\n\n";
393 #print ip_request "62.116.167.250"; 402 #print ip_request "62.116.167.250";
394 #print "\n\n";
395 #print ip_request "133.11.128.254"; # jp 403 #print ip_request "133.11.128.254"; # jp
396 #print "\n\n";
397# print ip_request "76.6.7.8"; 404# print ip_request "76.6.7.8";
398# print "\n\n";
399} 405}
400 406
4011; 4071;
402 408
403 409

Diff Legend

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