#!/usr/bin/perl # # Written by Leo Bicknell # # Do whatever you want to with this code, just don't blame me. # use strict; use CGI; use IO::Socket::INET; # n.b. Newer versions of perl/the IO::Socket library have done away # with the INET module, and you will need to change the above line # to "use IO::Socket;" # # $short_form is a hack, and needs to be fixed. # use vars qw($query $sock %months $short_form); %months = ( "01", "Jan", "02", "Feb", "03", "Mar", "04", "Apr", "05", "May", "06", "Jun", "07", "Jul", "08", "Aug", "09", "Sep", "10", "Oct", "11", "Nov", "12", "Dec" ); sub main(); sub printout($$); sub do_query($$); sub rwhois_query($$); sub print_html_domain($$); sub print_html_contact($); sub print_html_host($$); sub print_html_network($$); sub print_text_footer(); sub print_text_domain($$); sub print_text_contact($); sub print_text_contact_brief($); sub print_text_host($); sub print_text_network($$); main(); exit(0); sub main() { my($banner); my($responce); my($request); if (defined($ENV{'GATEWAY_INTERFACE'})) { $query = new CGI; print $query->header(-expires=>"-1", -pragma=>"no-cache"); print $query->start_html("rwhois query page"); print "

rwhois html interface, by Leo Bicknell

"; print "

Note: Queries now limited to 50 results due to "; print "page popularity until I can optimize the script a bit "; print "more. Sorry for any inconveniance.

"; print "

Network data returned here has been proven "; print "NOT TO MATCH "; print "whois.arin.net. The reason is unknown at this time.

\n"; print "<bicknell\@ufp.org>

"; print "\n"; } if (defined($ENV{'GATEWAY_INTERFACE'})) { $request = $query->param('keywords'); } else { $request = join(" ", @ARGV); } $request =~ s/^\s*//; $request =~ s/\s*$//; if (length($request) <= 0) { print "usage: whois [-h hostname] name ...\n"; if (defined($ENV{'GATEWAY_INTERFACE'})) { $query->end_html(); } exit(1); } $sock = IO::Socket::INET->new(PeerAddr => 'rwhois.arin.net', PeerPort => 'rwhois(4321)', Proto => 'tcp'); die "Undefined object: $!" if !defined($sock); die "Unable to connect: $!" if $sock->error; $banner = $sock->getline(); # Turn on holdconnect. $sock->print("-holdconnect on\n"); $responce = $sock->getline(); die "Server Failure: [$responce]" if (!$responce =~ /^\%ok/); # We want forwarding. $sock->print("-forward on\n"); $responce = $sock->getline(); die "Server Failure" if (!$responce =~ /^\%ok/); # Not too many results $sock->print("-limit 50\n"); $responce = $sock->getline(); die "Server Failure" if (!$responce =~ /^\%ok/); if ($request =~ /^\S+=\S+/) { $short_form = 1; } $0 = "rwhois: $request"; open(LOGFILE, ">>/tmp/rwhois.log") || die("Error: $!"); my($temp) = select(LOGFILE); $| = 1; select($temp); print LOGFILE "User query [$request]\n"; do_query($request, 1); # quit $sock->print("-quit\n"); $responce = $sock->getline(); die "Server Failure" if (!$responce =~ /^\%ok/); if (defined($ENV{'GATEWAY_INTERFACE'})) { print $query->end_html(); } } sub printout($$) { my($item, $recurse) = @_; if (defined($ENV{'GATEWAY_INTERFACE'})) { if ($$item{'Class-Name'} eq 'domain') { print_html_domain($item, $recurse); } elsif ($$item{'Class-Name'} eq 'contact') { print_html_contact($item); } elsif ($$item{'Class-Name'} eq 'host') { print_html_host($item, $recurse); } elsif ($$item{'Class-Name'} eq 'network') { print_html_network($item, $recurse); } } else { if ($$item{'Class-Name'} eq 'domain') { print_text_domain($item, 0); } elsif ($$item{'Class-Name'} eq 'contact') { if ($recurse) { print_text_contact($item); } else { print_text_contact_brief($item); } } elsif ($$item{'Class-Name'} eq 'host') { if ($recurse) { print_text_host($item); } else { printf " %-32s %s\n", $$item{'Host-Name'}, $$item{'IP-Address'}; } } elsif ($$item{'Class-Name'} eq 'network') { print_text_network($item, $recurse); } } } sub do_query($$) { my($request, $recurse) = @_; my(%item, $record); my($temphash); print LOGFILE "rwhois[$$] in do_query [$request]\n"; if ($request =~ /^\s*$/) { print "ERROR: Empty query string in do_query.\n"; return; } if ($request =~ /^\.\.$/) { # A special string the internic uses for some on hold # domains, don't query it, you get garbage. return; } rwhois_query($request, \%item); foreach $record (sort {$a <=> $b} keys(%item)) { $temphash = $item{$record}; printout($temphash, $recurse); } } sub rwhois_query($$) { my($request, $items) = @_; my($responce, $class, $ainfo, $value, $attr, $type, @others); my($x) = 1; # Send our query $sock->print("$request\n"); do { $responce = $sock->getline(); chomp($responce); while (!($responce =~ /^\%ok/) && !($responce =~ /^\s*$/) && !($responce =~ /^\%error/)) { ($class, $ainfo, $value) = ($responce =~ m/([^:]*):([^:]*):(.*)/); if (($attr, $type) = ($ainfo =~ m/([^;]*);(.*)/)) { } else { $attr = $ainfo; } if (defined($$items{$x}{$attr})) { $$items{$x}{$attr} = "$$items{$x}{$attr}|$value"; } else { $$items{$x}{$attr} = $value; } $responce = $sock->getline(); chomp($responce); } if ($responce =~ /\%error/) { $responce =~ s/\%error//; if (defined($ENV{'GATEWAY_INTERFACE'})) { print "

Server returned error: $responce

\n"; } else { print "Server returned error: $responce\n"; } return; } $x++; } while (!($responce =~ /^\%ok/)); } sub print_html_domain($$) { my($item, $recurse) = @_; my($me) = $query->url(); my($s); if ($short_form) { print "$$item{'Domain-Name'} "; print "($$item{'Handle'})
\n"; } else { # Domain type print out print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; foreach $s (split(/\|/, $$item{'Server'})) { print "\n"; } print "
Domain Info"; print "$$item{'Domain-Name'} "; print "($$item{'Handle'})
\n"; print "$$item{'Org-Name'}
"; print "$$item{'Street-Address'}
"; print "$$item{'City'} $$item{'State'} $$item{'Postal-Code'} "; print "$$item{'Country-Code'}
"; print "
Created: $$item{'Created'}
"; print "Updated: $$item{'Updated'}
"; print "
Admin-Contact"; if ($recurse) { do_query($$item{'Admin-Contact'}, 0); } else { print "$$item{'Admin-Contact'}"; } print "
Tech-Contact"; if ($recurse) { do_query($$item{'Tech-Contact'}, 0); } else { print "$$item{'Tech-Contact'}"; } print "
Billing-Contact"; if ($recurse) { do_query($$item{'Billing-Contact'}, 0); } else { print "$$item{'Billing-Contact'}"; } print "
Server"; if ($recurse) { do_query("host $s", 0); } else { print "$s"; } print "
\n"; } } sub print_html_contact($) { my($item) = @_; my($me) = $query->url(); # Contact print out print "$$item{'Handle'}
"; print "$$item{'First-Name'} $$item{'Last-Name'} ($$item{'Name'})
"; print "$$item{'Email'}
"; print "$$item{'Org-Name'}
"; print "$$item{'Street-Address'}
"; print "$$item{'City'} $$item{'State'} $$item{'Postal-Code'} "; print "$$item{'Country-Code'}
"; print "$$item{'Phone'}"; if (defined($$item{'Fax'})) { print " (FAX) $$item{'Fax'}"; } print "
Show all domains for whom this person is the "; print "Admin, "; print "Tech, or "; print "Billing, "; print "contact.
"; print "
"; print "
Created: $$item{'Created'}
"; print "Updated: $$item{'Updated'}
"; } sub print_html_host($$) { my($item, $recurse) = @_; my($me) = $query->url(); # host print out print "\n"; print "\n"; print ""; print "
Host Information"; print "$$item{'Handle'}
"; print "$$item{'Host-Name'} ($$item{'IP-Address'})
"; print "Show all domains "; print "served by this machine.
"; # print "Show all in-addr "; # print "domains served by this machine.
"; print "
"; print "Updated: $$item{'Updated'}
"; print "
Host Contact"; if ($recurse) { if (length($$item{'Tech-Contact'}) > 1) { do_query("contact $$item{'Tech-Contact'}", 0); } else { print " No technical contact.\n"; } } else { print "$$item{'Tech-Contact'}"; } print "
\n"; } sub print_html_network($$) { my($item, $recurse) = @_; my($me) = $query->url(); my($s); return if ($$item{'Network-Name'} =~ /RESERVED/i); print "\n"; print "\n"; print "\n"; } print "
Network Info"; print "$$item{'Network-Name'} $$item{'IP-Network'} "; print "($$item{'Handle'})
"; print "$$item{'Org-Name'}
"; print "$$item{'Street-Address'}
"; print "$$item{'City'} $$item{'State'} $$item{'Postal-Code'} "; print "$$item{'Country-Code'}
"; print "
Created: $$item{'Created'}
"; print "Updated: $$item{'Updated'}
"; print "
Tech-Contact"; if ($recurse) { if (length($$item{'Tech-Contact'}) > 1) { do_query("contact $$item{'Tech-Contact'}", 0); } else { print " No technical contact.\n"; } } else { print "$$item{'Tech-Contact'}"; } foreach $s (split(/\|/, $$item{'In-Addr-Server'})) { print "
in-addr Server"; if ($recurse) { do_query("host $s", 0); } else { print "$s"; } print "
\n"; } sub print_text_footer() { print "\n"; print "The InterNIC Registration Services database contains ONLY\n"; print "non-military and non-US Government Domains and contacts.\n"; print "Other associated whois servers:\n"; print " American Registry for Internet Numbers - whois.arin.net\n"; print " European IP Address Allocations - whois.ripe.net\n"; print " Asia Pacific IP Address Allocations - whois.apnic.net\n"; print " US Military - whois.nic.mil\n"; print " US Government - whois.nic.gov\n"; } sub print_text_domain($$) { my($item, $recurse) = @_; my($year, $mon, $day); my($s); print "\n"; print "Registrant:\n"; print "$$item{'Org-Name'} ($$item{'Handle'})\n"; print " $$item{'Street-Address'}\n"; print " $$item{'City'} $$item{'State'} $$item{'Postal-Code'}\n"; print " $$item{'Country-Code'}\n"; print "\n"; print " Domain Name: $$item{'Domain-Name'}\n"; print "\n"; print " Administrative Contact:\n"; do_query("contact $$item{'Admin-Contact'}", 0); print " Technical Contact:\n"; do_query("contact $$item{'Tech-Contact'}", 0); print " Billing Contact:\n"; do_query("contact $$item{'Billing-Contact'}", 0); print "\n"; ($year,$mon,$day) = ($$item{'Updated'} =~ m/^(....)(..)(..)/); print " Record last updated on $day-$months{$mon}-$year\n"; ($year,$mon,$day) = ($$item{'Created'} =~ m/^(....)(..)(..)/); print " Record created on $day-$months{$mon}-$year\n"; print "\n"; print "Domain servers in listed order:\n"; print "\n"; foreach $s (split(/\|/, $$item{'Server'})) { do_query("host $s", 0); } print "\n"; print_text_footer(); } sub print_text_contact($) { my($item) = @_; my($year, $mon, $day); print "$$item{'Name'} ($$item{'Handle'}) $$item{'Email'}\n"; print " $$item{'Org-Name'}\n" if defined($$item{'Org-Name'}); print " $$item{'Street-Address'}\n"; print " $$item{'City'} $$item{'State'} $$item{'Postal-Code'}\n"; print " $$item{'Country-Code'}\n"; print " $$item{'Phone'}"; if (defined($$item{'Fax'})) { print " (FAX) $$item{'Fax'}"; } print "\n"; print "\n"; ($year,$mon,$day) = ($$item{'Updated'} =~ m/^(....)(..)(..)/); print " Record last updated on $day-$months{$mon}-$year\n"; ($year,$mon,$day) = ($$item{'Created'} =~ m/^(....)(..)(..)/); print " Record created on $day-$months{$mon}-$year\n"; print "\n"; print_text_footer(); } sub print_text_contact_brief($) { my($item) = @_; print " $$item{'Name'} ($$item{'Handle'}) $$item{'Email'}\n"; print " $$item{'Phone'}"; if (defined($$item{'Fax'})) { print " (FAX) $$item{'Fax'}"; } print "\n"; } sub print_text_host($) { my($item) = @_; my($year, $mon, $day); print "[No name] ($$item{'Handle'})\n"; print "\n"; print " Hostname: $$item{'Host-Name'}\n"; print " Address: $$item{'IP-Address'}\n"; print " System: ? running ?\n"; print "\n"; print " Coordinator:\n"; if (length($$item{'Tech-Contact'}) > 1) { do_query("contact $$item{'Tech-Contact'}", 0); } else { print " No technical contact.\n"; } print "\n"; ($year,$mon,$day) = ($$item{'Updated'} =~ m/^(....)(..)(..)/); print " Record last updated on $day-$months{$mon}-$year\n"; ($year,$mon,$day) = ($$item{'Created'} =~ m/^(....)(..)(..)/); print " Record created on $day-$months{$mon}-$year\n"; print "\n"; print_text_footer(); } sub print_text_network($$) { my($item, $recurse) = @_; my($s); my($year,$mon,$day); return if ($$item{'Network-Name'} =~ /RESERVED/i); print "$$item{'Org-Name'} ($$item{'Handle'})\n"; print " $$item{'Street-Address'}\n"; print " $$item{'City'} $$item{'State'} $$item{'Postal-Code'} "; print " $$item{'Country-Code'}\n"; print "\n"; print " Netname: $$item{'Network-Name'}\n"; print " Netnumber: $$item{'IP-Network'}\n"; print "\n"; print " Coordinator:\n"; if (length($$item{'Tech-Contact'}) > 1) { do_query("contact $$item{'Tech-Contact'}", 0); } else { print " No technical contact.\n"; } print "\n"; print " Domain System inverse mapping provided by:\n"; print "\n"; foreach $s (split(/\|/, $$item{'In-Addr-Server'})) { do_query("host $s", 0); } print "\n"; ($year,$mon,$day) = ($$item{'Updated'} =~ m/^(....)(..)(..)/); print " Record last updated on $day-$months{$mon}-$year\n"; ($year,$mon,$day) = ($$item{'Created'} =~ m/^(....)(..)(..)/); print " Record created on $day-$months{$mon}-$year\n"; print "\n"; # print "The ARIN Registration Services Host contains ONLY Internet\n"; # print "Network Information: Networks, ASN's, and related POC's.\n"; # print "Please use the whois server at rs.internic.net for DOMAIN related\n"; # print "Information and nic.mil for NIPRNET Information.\n"; }