#!/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 "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 " |
\n";
print "Admin-Contact | ";
if ($recurse) {
do_query($$item{'Admin-Contact'}, 0);
} else {
print "$$item{'Admin-Contact'}";
}
print " |
\n";
print "Tech-Contact | ";
if ($recurse) {
do_query($$item{'Tech-Contact'}, 0);
} else {
print "$$item{'Tech-Contact'}";
}
print " |
\n";
print "Billing-Contact | ";
if ($recurse) {
do_query($$item{'Billing-Contact'}, 0);
} else {
print "$$item{'Billing-Contact'}";
}
print " |
\n";
foreach $s (split(/\|/, $$item{'Server'})) {
print "Server | ";
if ($recurse) {
do_query("host $s", 0);
} else {
print "$s";
}
print " |
\n";
}
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 "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 " |
\n";
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 " |
";
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 "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 " |
\n";
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";
}
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";
}