Coro/myhttpd/netgeo.pl

#!/usr/bin/perl

# APNIC refer: KRNIC (for 211.104.0.0)

use Socket;
use Fcntl;

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

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

tie %netgeo::whois, BerkeleyDB::Btree,
    -Env => $db_env,
    -Filename => "whois",
    -Flags => DB_CREATE,
       or die "unable to create/open whois table";
$netgeo::iprange = new BerkeleyDB::Btree
    -Env => $db_env,
    -Filename => "iprange",
    -Flags => DB_CREATE,
       or die "unable to create/open iprange table";

package Whois;

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 = "$self->{name}\x0$query";
   my $whois = $netgeo::whois{$id};

   unless (defined $whois) {
      print "WHOIS($self->{name},$query)\n";

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

      $netgeo::whois{$id} = $whois;
   }

   $whois;
}

package Whois::ARIN;

use Date::Parse;

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

use BerkeleyDB;
use Socket;

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;

$whoislock = new Coro::SemaphoreSet;

sub ip_request {
   my $ip = $_[0];

   my $guard = $whoislock->guard($ip);

   my $c = $iprange->db_cursor;
   my $v;

   if (!$c->c_get((inet_aton $ip), $v, DB_SET_RANGE)) {
      my ($ip0, $ip1, $whois) = split /\x0/, $v;
      my $_ip = ip2int $ip;
      if ($ip0 <= $_ip && $_ip <= $ip1) {
         return $whois;
      }
   }

   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 do { warn "$whois($ip): no addresses found\n", last };

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

   my $_ip  = ip2int($ip);
   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;
   }

   $iprange->db_put((pack "N", $_ip1), (join "\x0", $_ip0, $_ip1, $whois));
   (tied %whois)->db_sync;
   $iprange->db_sync;

   $whois;
}


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