############################################################## sub whois_contact { my($ip)=@_; unless($ip =~ /^(\d+\.\d+\.\d+).\d+$/) { warn "$ip isn't a dotted quad?\n"; return; } my $c=$1.".0"; DEBUG and warn "C-class $c\n"; return $CONTACTS{$c} if exists $CONTACTS{$c}; local $ENV{PATH}='/bin:/usr/bin:/usr/local/bin'; delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; my $whois='whois.arin.net'; my $text=fetch_whois($c, $whois); unless($text) { die "No answer from whois??\n"; } elsif($text =~ /NO MATCH IP/) { warn $text; return; } my $contact=''; do { if($text =~ /To single out one record/ or ($text =~ /arin\.net/ and not $text =~ /Updated:/)) { my @handle=get_contacts($text); return unless @handle; my $handle; foreach my $h (@handle) { my $n=($h->{number}||$h->{low}); next if $n ne $c or $h->{handle} eq $contact; $handle=$h; last; } $handle=$handle[0] if not $handle; die "No handle for $c\n", Dumper \@handle unless $handle; die "No handle in $text", Dumper \@handle unless $handle->{handle}; $text =fetch_whois($handle->{netblk}, $whois); $contact=$handle->{handle}; } if($text=~/These addresses have been further/) { unless($text=~ /(?:database,?|servers)\s+at\s+(w[.\w]+)\W/) { warn "$1 $2" if $text =~ /(database,?)\s+at\s+(.+)/; die "No new server in '$text'\n"; } $whois=$1; unless($text=~ /Netname:\s+([-\w]+)/i) { die "No Netname: in $text\n"; } $text=fetch_whois($c, $whois); } }; if($text=~/arin\.net/) { if($text =~ m(\[whois\.arin\.net\]\s+ # header (.+?)\s+ # name \x28(\w+-?([-\w]+?))\x29\s+ # (NETBLK-HANDLE) (.+?)\s+ # address Netname:\s+(?:\w+-?[-\w]+?)\s+ # HANDLE Netblock:\s+([.\d]+)\s+-\s+([.\d]+)\s+ # LOW - HIGH (?:Maintainer:\s+.+?)?\s* Coordinator:\s+ (.+?)\s+ \x28([-\w]+)\x29\s+(.+\@\S+)\s+ # name (handle) email # ([^\n]+) # fone number # (?:ADDRESS.+?)?\s+ # ignore # (?:Domain\sSystem.+)?\s+ # ignore # Record\slast\supdated\son\s+(.+?)\.\s+ # update # Database\slast\supdated\son\s+(.+?)\. # database)xs) { $CONTACTS{$c}={ name=>$1, netblk=>$2, handle=>$3, address=>$4, low=>$5, high=>$6, coordinator=>{name=>$7, handle=>$8, email=>$9}, # update=>$11, database=>$12, }; $CONTACTS{$c}->{coordinator}{telephone}=$10 if $10; } else { $CONTACTS{$c}={}; $text=~ /OrgName:\s*(.+)/; $CONTACTS{$c}{name}=$1; $text=~ /NetHandle:\s+(.+)/; $CONTACTS{$c}{handle}=$1; $text=~ /NetName:\s+(.+)/; $CONTACTS{$c}{netblk}=$1; $text=~ /NetRange:\s+([.\d]+)\s+-\s+([.\d]+)/; $CONTACTS{$c}{low}=$1; $CONTACTS{$c}{high}=$2; foreach my $type (qw(Tech OrgTech)) { foreach my $field (qw(name handle email)) { next unless $text=~ /^$type\u$field:\s+(.+)/m; $CONTACTS{$c}{coordinator}{$field}=$1; } } # die Denter $CONTACTS{$c}; } } elsif($text=~/\[whois.?\.apnic\.net\]/) { $CONTACTS{$c}={}; my @paras=split /\n\n/, $text; $CONTACTS{$c}{name}=join ' - ', ($text=~ /descr:\s+(.+)\n/g); $text=~ /netname:\s+(.+)\n/; $CONTACTS{$c}{netblk}=$1; $CONTACTS{$c}{handle}=$CONTACTS{$c}{netblk}; $CONTACTS{$c}{address}=join "\n", ($paras[3] =~ /address:\s+(.+)\n/g); $text =~ /inetnum:\s+([\d.]+) -/g; $CONTACTS{$c}{low}=$1; $text =~ /inetnum:\s+[\d.]+ - ([\d.]+)/; $CONTACTS{$c}{high}=$1; $CONTACTS{$c}{coordiantor}={}; $paras[3] =~ /person:\s+(.+)\n/; $CONTACTS{$c}{coordiantor}{name}=$1; $paras[3] =~ /nic-hdl:\s+(.+)\n/; $CONTACTS{$c}{coordiantor}{handle}=$1; $paras[3] =~ /phone:\s+(.+)\n/; $CONTACTS{$c}{coordiantor}{telephone}=$1; $paras[3] =~ /e-mail:\s+(.+)\n/; $CONTACTS{$c}{coordiantor}{email}=$1; $text =~ /changed:\s+.+?(\d+)\n/; $CONTACTS{$c}{update}=$1; # die Dumper $CONTACTS{$c}; } # die "$1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 $12"; $CONTACTS{$c}->{address} =~ s/\n\s+/\n/g if $CONTACTS{$c}->{address}; return $CONTACTS{$c}; } ############################################################## sub get_contacts { my($text)=@_; unless($text =~ m/\[whois.arin.net\](.+?)#/s) { warn "Can't fathom $text"; return; } $text=$1; my @contacts; # warn $text; while($text=~m((.+?) \s+ # name \x28 (NET(?:BLK)?-([-\w]+)) \x29 # (NETBLK-HANDLE) \s+ (?:\2|\3)? \s+ # HANDLE (?:(?:([.\d]+) \s+-\s+ ([.\d]+)) # LOW - HIGH or | ([.\d]+)) \s* # NUMBER )gxs) { push @contacts, {name=>$1, handle=>$3, netblk=>$2}; if($5) { $contacts[-1]->{high}=$5; $contacts[-1]->{low}=$4; } else { $contacts[-1]->{number}=$4; } die "no name $text '$1 $2 $3 $4'\n", Dumper \@contacts unless $contacts[-1]->{name}; $contacts[-1]->{name}=~s/^\s+//; $contacts[-1]->{name}=~s/\s+$//; } # Canadian Registry (NETBLK-CA-RISQ3) CA-REGISTRY3 206.123.0.0 - 206.123.255.255 # AEI Internet Inc. (NET-AEI1-CA) AEI1-CA 206.123.6.0 - 206.123.6.255 die "Can't grok this choice '$text'" unless @contacts; return @contacts; } ################################################################ sub fetch_whois { my($handle, $host)=@_; DEBUG and warn "whois $handle\@$host\n"; return $WHOIS{$host}{$handle} if exists $WHOIS{$host}{$handle}; while(1) { $WHOIS{$host}{$handle}=`whois $handle\@$host 2>&1`; last unless $WHOIS{$host}{$handle} =~ /Connection refused/; warn $WHOIS{$host}{$handle}; warn "Connection to $host refused, waiting a minute\n"; sleep 60; warn "trying\n"; } return $WHOIS{$host}{$handle}; }