Coro/myhttpd/netgeo.pl

#!/usr/bin/perl

# APNIC refer: KRNIC (for 211.104.0.0)

use Socket;
use Fcntl;

use PApp::SQL;

use Coro;
use Coro::Event;
use Coro::Semaphore;
use Coro::Socket;

$Event::DIED = sub {
   Event::verbose_exception_handler(@_);
   #Event::unloop_all();
};

$PApp::SQL::DBH = PApp::SQL::connect_cached __FILE__, "DBI:mysql:netgeo" or die;

package Whois;

use PApp::SQL;
use Coro::Event;

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 ip {
   $_[0]{ip};
}

sub sanitize {
   $_[1];
}

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

   my $st = sql_exec \($id, $whois),
                     "select id, whois from whois
                      where nic = ? and query = ?",
                     $self->{name}, $query;

   Coro::cede;

   unless ($st->fetch) {
      my $guard = $self->{maxjobs}->guard;
      my $timeout = 5;

      while () {
         my $fh = new Coro::Socket
                         PeerAddr => $self->ip,
                         PeerPort => 'whois',
                         Timeout  => 30;
         if ($fh) {
            print $fh "$query\n";
            $fh->read($whois, 16*1024); # max 16k. whois stored
            close $fh;
            $whois =~ s/\015?\012/\n/g;
            $whois = $self->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#
               do_timer(desc => "timer2", after => $timeout);
               $timeout *= 2;
               $timeout = 1 if $timeout > 600;
            } else {
               last;
            }
         }
      }

      sql_exec "replace into whois values (NULL,?,?,NULL,?,?)",
               $self->{name}, $query, $whois, time;

      my $st = sql_exec \$id,
                        "select id from whois
                         where nic = ? and query = ?",
                        $self->{name}, $query;
      $st->fetch or die;
   }

   $whois;
}

package Whois::ARIN;

use Date::Parse;
use PApp::SQL;

use base Whois;

sub sanitize {
   local $_ = $_[1];
   s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;
   $_;
}

# there are only two problems with arin's whois database:
# a) the data cannot be trusted and often is old or even wrong
# b) the database format is nonparsable
#    (no spaces between netname/ip and netnames can end in digits ;)
# of course, the only source to find out about global
# address distribution is... arin.
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, bbut bad because ripe might not have better info
      }
      $handle or die "$whois ($ip): unparseable multimatch\n";
      $whois = $self->whois_request("!$handle");
   }

   my ($address, $info, $coordinator, undef) = split /\n\n/, $whois;

   $info =~ /^\s+Netname: (\S+)$/mi
      or die "$whois($ip): no netname\n";
   my $netname = $1;

   $info =~ /^\s+Netblock: ([0-9.]+\s+-\s+[0-9.]+)\s*$/mi
      or die "$whois($ip): no netblock\n";
   my $netblock = $1;

   my $maintainer;

   if ($info =~ /^\s+Maintainer: (\S+)\s*$/mi) {
      $maintainer = "*ma: $1\n";
      return if $1 =~ /^(?:AP|RIPE)$/;
   }

   $coordinator =~ s/^\s+Coordinator:\s*//si
      or $coordinator = "";

   $address =~ s/\n\s*(\S+)$//
      or die "$whois($ip): no parseable country ($address)\n";
   my $country = $1;

   $address     =~ s/^\s*/*de: /mg;
   $coordinator =~ s/^\s*/*ad: /mg;

   $whois = <<EOF;
*in: $netblock
*na: $netname
*cy: $country
$maintainer$address
$coordinator
EOF
   $whois =~ s/\n+$//;
   $whois;
}

package Whois::RIPE;

use PApp::SQL;

use base Whois;

sub sanitize {
   local $_ = $_[1];
   s/^%.*\n//gm;
   s/^\n+//;
   s/\n*$/\n/;
   $_;
}

sub ip_request {
   my ($self, $ip) = @_;

   my $whois = $self->whois_request("-FSTin $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 main;

sub ip2int($) {
   unpack "N", inet_aton $_[0];
}

sub int2ip($) {
   inet_ntoa pack "N", $_[0];
}

our %WHOIS;

$WHOIS{ARIN}  = new Whois::ARIN ARIN  => "whois.arin.net",  maxjobs => 12;
$WHOIS{RIPE}  = new Whois::RIPE RIPE  => "whois.ripe.net",  maxjobs => 20;
$WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", maxjobs => 20;

sub ip_request {
   my $ip = $_[0];
   my $_ip = ip2int($ip);

   my $st = sql_exec \my($whois, $ip0),
                     "select data, ip0 from iprange
                      where ? <= ip1
                      having ip0 <= ?
                      order by ip1
                      limit 1",
                     $_ip, $_ip;

   Coro::cede;
  
   unless ($st->fetch) {
      my ($arin, $ripe, $apnic);

      $whois = $WHOIS{APNIC}->ip_request($ip)
            || $WHOIS{RIPE} ->ip_request($ip)
            || $WHOIS{ARIN} ->ip_request($ip);

      $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
         or warn "$whois($ip): no addresses found\n";
      $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
         or return;

      $whois =~ /^\*in: ([0-9.]+)\s+-\s+([0-9.]+)\s*$/mi
         or die "$whois($ip): no addresses found\n";

      my ($ip0, $ip1) = ($1, $2);

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

      sql_exec "replace into iprange values (?, ?, NULL, ?)",
               $_ip0, $_ip1, $whois;

      #print "$ip ($ip0, $ip1 ($_ip0, $_ip1)\n$whois\n";
   }

   $whois;
}


Revision:	1.1
Committed:	Sat Aug 11 00:37:32 2001 UTC (22 years, 11 months ago) by root
Content type:	text/plain
Branch:	MAIN
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			use PApp::SQL;
9
10			use Coro;
11			use Coro::Event;
12			use Coro::Semaphore;
13			use Coro::Socket;
14
15			$Event::DIED = sub {
16			Event::verbose_exception_handler(@_);
17			#Event::unloop_all();
18			};
19
20			$PApp::SQL::DBH = PApp::SQL::connect_cached __FILE__, "DBI:mysql:netgeo" or die;
21
22			package Whois;
23
24			use PApp::SQL;
25			use Coro::Event;
26
27			sub new {
28			my $class = shift;
29			my $name = shift;
30			my $ip = shift;
31			my $self = bless { name => $name, ip => $ip, @_ }, $class;
32			$self->{maxjobs} = new Coro::Semaphore $self->{maxjobs} \|\| 1;
33			$self;
34			}
35
36			sub ip {
37			$_[0]{ip};
38			}
39
40			sub sanitize {
41			$_[1];
42			}
43
44			sub whois_request {
45			my ($self, $query) = @_;
46			my ($id, $whois);
47
48			my $st = sql_exec \($id, $whois),
49			"select id, whois from whois
50			where nic = ? and query = ?",
51			$self->{name}, $query;
52
53			Coro::cede;
54
55			unless ($st->fetch) {
56			my $guard = $self->{maxjobs}->guard;
57			my $timeout = 5;
58
59			while () {
60			my $fh = new Coro::Socket
61			PeerAddr => $self->ip,
62			PeerPort => 'whois',
63			Timeout => 30;
64			if ($fh) {
65			print $fh "$query\n";
66			$fh->read($whois, 16*1024); # max 16k. whois stored
67			close $fh;
68			$whois =~ s/\015?\012/\n/g;
69			$whois = $self->sanitize($whois);
70			if ($whois eq ""
71			or ($whois =~ /query limit/i && $whois =~ /exceeded/i) # ARIN
72			or ($whois =~ /wait a while and try again/i) # ARIN
73			or ($whois =~ /^%ERROR:202:/) # RIPE/APNIC
74			) {
75			print "retrying in $timeout seconds\n";#d#
76			do_timer(desc => "timer2", after => $timeout);
77			$timeout *= 2;
78			$timeout = 1 if $timeout > 600;
79			} else {
80			last;
81			}
82			}
83			}
84
85			sql_exec "replace into whois values (NULL,?,?,NULL,?,?)",
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			}
94
95			$whois;
96			}
97
98			package Whois::ARIN;
99
100			use Date::Parse;
101			use PApp::SQL;
102
103			use base Whois;
104
105			sub sanitize {
106			local $_ = $_[1];
107			s/\n[\t ]{6,}([0-9.]+ - [0-9.]+)/ $1/g;
108			$_;
109			}
110
111			# there are only two problems with arin's whois database:
112			# a) the data cannot be trusted and often is old or even wrong
113			# b) the database format is nonparsable
114			# (no spaces between netname/ip and netnames can end in digits ;)
115			# of course, the only source to find out about global
116			# address distribution is... arin.
117			sub ip_request {
118			my ($self, $ip) = @_;
119
120			my $whois = $self->whois_request($ip);
121
122			return () if $whois =~ /^No match/;
123
124			if ($whois =~ /^To single out one record/m) {
125			my $handle;
126			while ($whois =~ /\G\S.\(([A-Z0-9\-]+)\).\n/mg) {
127			$handle = $1;
128			#return if $handle =~ /-(RIPE\|APNIC)/; # heuristic, bbut bad because ripe might not have better info
129			}
130			$handle or die "$whois ($ip): unparseable multimatch\n";
131			$whois = $self->whois_request("!$handle");
132			}
133
134			my ($address, $info, $coordinator, undef) = split /\n\n/, $whois;
135
136			$info =~ /^\s+Netname: (\S+)$/mi
137			or die "$whois($ip): no netname\n";
138			my $netname = $1;
139
140			$info =~ /^\s+Netblock: ([0-9.]+\s+-\s+[0-9.]+)\s*$/mi
141			or die "$whois($ip): no netblock\n";
142			my $netblock = $1;
143
144			my $maintainer;
145
146			if ($info =~ /^\s+Maintainer: (\S+)\s*$/mi) {
147			$maintainer = "*ma: $1\n";
148			return if $1 =~ /^(?:AP\|RIPE)$/;
149			}
150
151			$coordinator =~ s/^\s+Coordinator:\s*//si
152			or $coordinator = "";
153
154			$address =~ s/\n\s*(\S+)$//
155			or die "$whois($ip): no parseable country ($address)\n";
156			my $country = $1;
157
158			$address =~ s/^\s/de: /mg;
159			$coordinator =~ s/^\s/ad: /mg;
160
161			$whois = <<EOF;
162			*in: $netblock
163			*na: $netname
164			*cy: $country
165			$maintainer$address
166			$coordinator
167			EOF
168			$whois =~ s/\n+$//;
169			$whois;
170			}
171
172			package Whois::RIPE;
173
174			use PApp::SQL;
175
176			use base Whois;
177
178			sub sanitize {
179			local $_ = $_[1];
180			s/^%.*\n//gm;
181			s/^\n+//;
182			s/\n*$/\n/;
183			$_;
184			}
185
186			sub ip_request {
187			my ($self, $ip) = @_;
188
189			my $whois = $self->whois_request("-FSTin $ip");
190
191			$whois =~ /^\*in: 0\.0\.0\.0 - 255\.255\.255\.255/
192			and return;
193
194			$whois =~ /^\*ac: XXX0/m # 192.0.0.0
195			and return;
196
197			$whois =~ /^%ERROR:/m
198			and return;
199
200			#while ($whois =~ s/^\*(?:ac\|tc):\s+(\S+)\n//m) {
201			# $whois .= $self->whois_request("-FSTpn $1");
202			#}
203
204			$whois =~ s/^\(?:pn\|nh\|mb\|ch\|so\|rz\|ny\|st\|rm):.\n//mg;
205
206			$whois =~ s/\n+$//;
207
208			$whois;
209			}
210
211			package main;
212
213			sub ip2int($) {
214			unpack "N", inet_aton $_[0];
215			}
216
217			sub int2ip($) {
218			inet_ntoa pack "N", $_[0];
219			}
220
221			our %WHOIS;
222
223			$WHOIS{ARIN} = new Whois::ARIN ARIN => "whois.arin.net", maxjobs => 12;
224			$WHOIS{RIPE} = new Whois::RIPE RIPE => "whois.ripe.net", maxjobs => 20;
225			$WHOIS{APNIC} = new Whois::RIPE APNIC => "whois.apnic.net", maxjobs => 20;
226
227			sub ip_request {
228			my $ip = $_[0];
229			my $_ip = ip2int($ip);
230
231			my $st = sql_exec \my($whois, $ip0),
232			"select data, ip0 from iprange
233			where ? <= ip1
234			having ip0 <= ?
235			order by ip1
236			limit 1",
237			$_ip, $_ip;
238
239			Coro::cede;
240
241			unless ($st->fetch) {
242			my ($arin, $ripe, $apnic);
243
244			$whois = $WHOIS{APNIC}->ip_request($ip)
245			\|\| $WHOIS{RIPE} ->ip_request($ip)
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);
259			my $_ip1 = ip2int($ip1);
260
261			if ($_ip0 + 256 < $_ip1) {
262			$_ip = $_ip & 0xffffff00;
263			$_ip0 = $_ip if $_ip0 < $_ip;
264			$_ip1 = $_ip + 255 if $_ip1 > $_ip + 255;
265			}
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			}
272
273			$whois;
274			}
275
276
277