#!/usr/local/bin/perl

$| = 1;

print "Content-type: text/html\n\n";


##############################################
# WebWho+ programmed for Cyberstrider Ltd 
# By Tony Greenwood (TonyG  tony@worden.co.uk)
# 11th January 2002	
# Please mention www.webwho.co.uk somewhere
##############################################

# IMPORTANT
# A coder can spot his code no matter how much it is hacked 
# I spot my code all over the place and thats great. But not when 
# you put your name next to it when all you did was change
# the way it looks...If you want to be a coder then start by playing fair OK :)
#
### SETUP ###
# Presuming the first line showing the path to Perl is correct then
# WebWho will run  straight from the box. However you may
# want to change the look and feel as well as the domain
# searches and other neat stuff
#
#
#
###### MAIN SUBMIT BUTTON GRAPHIC OR STANDARD BUTTON
my $submit_form="<INPUT STYLE='background-color:#FFB709' TYPE='submit' NAME='Check' value='Check it!'>";
#my $submit_form="<INPUT TYPE='image' src='/gfx/submit.gif' border=0 align='absmiddle'>";
#
##### TABLES
# table sizes
my $tw='420';		# Actual Table width
my $t1='250';		# Domain name cell
my $t2='80';		# Result cell
my $t3='90';		# Extra info cell
my $border=1;		# Table border, This is my sexy border and not the crappy table border
# table colors

my $webwhobar="#21299C"; 	# WebWho bar
my $input_area="#63adde";		# Type in the domain
my $list_names="#FFB709";		# Domain, result, Info
my $extras="#FFB709";		# Available or Check action
my $available="#63adde";		# row of info if available
my $unavailable="#1f5ca1";		# Row of info if not available
my $errorbox="red";		# server down or not responding row
my $details="#63adde";		# Info returned on a single whois
#
#### PAGE
# text colors
my $font=" size=2 face=\"Verdana, Arial,Helvetica, sans-serif\""; 	# Whenever you use $font :)
my $links="white";						# Body default ,Also hlink, vlink
my $text="black";						# Body default
my $webwhobart="white"; 		# WebWho bar
my $input_areat="black";		# Type in the domain
my $list_namest="black";		# Domain, result, Info
my $errorboxt="white";		# server down or not responding row
my $detailst="black";		# Info returned on a single whois
# page
my $background="white";					# page background
#
# messages
my $alltext="All";						# In drop down list to check for all
my $whatnext="<font color='black' $font>Available</font>";		# TLD is Available
my $taken="<font color='white' $font>Taken</font>";		# TLD is Taken
my $details1="<font color='black' $font><b>Details</b></font>";	# See detailed lookup
my $details2="<font color='black' $font><b>Check</b></font>";	# Same as to check if result is true
#
#
##### TLDS ######
# There are 3 elements to each TLD seperated by a comma.
# (1) The TLD to search for
# (2) The Database to search in
# (3) The text to search for if No match ie Is available
# You can add or take away tlds but make sure numbers in the
# angle brackes run from 0 to whatever
my @tld;
$tld[0]="co.uk,whois.nic.uk,No match";
$tld[1]="org.uk,whois.nic.uk,No match";
$tld[2]="me.uk,whois.nic.uk,No match";
$tld[3]="net.uk,whois.nic.uk,No match";
$tld[4]="ltd.uk,whois.nic.uk,No match";
$tld[5]="plc.uk,whois.nic.uk,No match";
$tld[6]="com,whois.crsnic.net,No match";
$tld[7]="net,whois.crsnic.net,No match";
$tld[8]="org,whois.publicinterestregistry.net,NOT FOUND";
$tld[9]="edu,whois.crsnic.net,No match";
$tld[10]="eu.com,whois.centralnic.com,No match";
$tld[11]="gb.com,whois.centralnic.com,No match";
$tld[12]="gb.net,whois.centralnic.com,No match";
$tld[13]="uk.com,whois.centralnic.com,No match";
$tld[14]="uk.net,whois.centralnic.com,No match";
$tld[15]="us.com,whois.centralnic.com,No match";
$tld[16]="info,whois.afilias.net,NOT FOUND";
$tld[17]="biz,whois.neulevel.biz,Not found:";
my $me = "webwho.cgi";	# Change this if you change the name of the script 
my $timeout=12;		# Seconds to check WHOIS. More seconds gives more chance

## STOP SETUP ##

#use diagnostics;
#use strict;
#use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard);
use IO::Socket;

# Variables used throughout the script
my ($i,$output,$what,$lupe,$timeblunder);
my @splitz;
my @result;
my @isit;
my @extras;
my $all=1;
my $more=0;

my $query=new CGI;
my %stuff = map {$_, $query->param($_)} $query->param();
if (defined $stuff{'command'})
	{
	$stuff{'command'}=&cleanup($stuff{'command'});
	}
else
	{$stuff{'command'}="";}
if (!defined $stuff{'type'} or $stuff{'type'} eq ""){$stuff{'type'}=$alltext;}
$stuff{'type'} =~ tr/A-Z/a-z/;
foreach $i (@tld)
	{
	@splitz=split(/,/,$i);
	if($stuff{'type'} eq $splitz[0]){$all=0;}
	}
if ($all){$stuff{'type'}=$alltext;}

######################
# START THE HTML


#&fatal_error("$stuff{'command'}*<br>$stuff{'type'}+");



if ($stuff{'command'} eq "")
	{
	&my_header;
	&my_footer;
	exit;
	}
if (length($stuff{'command'})<3)
	{&fatal_error("Sorry wrong amount of characters");} 
if (! $all)
	{
	&my_header;
	$more=1;
	$output=&domainchk($stuff{'command'},$stuff{'type'});
	&showone;
	&my_footer;
	exit;
	}
if ($all)
	{
	&all;
	exit;
	}
&fatal_error("Wierd? Ya really shouldn't have made it to here :(");
exit;

sub cleanup()
	{
	$_[0]=substr($_[0],0,70); 
	$_[0] =~ tr/A-Z/a-z/;		
	$_[0] =~ s/http\:\/\///gi;	
	$_[0] =~ s/www\.//gi;		
	$_[0] =~ s/[^a-z0-9\-]//g;	
	$_[0] =~ s/^\-+//;		
	$_[0] =~ s/\-+$//g;		
	$_[0] =~ s/\s//g;		
	return $_[0];
	}

sub domainchk()
	{

	foreach $i (@tld)
		{
		my $this=$_[0];
		my $that=$_[1];
		my @splitx=split(/,/,$i);
		if ($splitx[0] eq $that)
			{
			eval 
				{
        				local $SIG{ALRM} = sub { die "alarm\n" };    
        				alarm ($timeout);
				$what  = IO::Socket::INET->new("$splitx[1]:43") or return ("$splitx[1] Server not responding");
				print $what "$this.$that\n";
				@result=<$what>;
				close $what;
				chop(@result);
				alarm (0);
				};
			if ($@ eq "alarm\n") 
				{	        
				return ("$splitx[1] Server Timed Out")
   				}
    				elsif ($@)
    				{
				return ("$splitx[1] Server Unexplained Error")
    				}


			
			# We know we got a valid return and no problems at this point
			my $whatis="$this.$that is Unavailable";
			foreach $i (@result) 
	 			{
                			if ($i =~ /Whois Server: whois./ and $more)
					{
					my $ckl=$i;
					$ckl=~s/Whois Server: //;
					$ckl =~ s/\s+//;
					my $added="";
					eval 
						{
        						local $SIG{ALRM} = sub { die "timed\n" };    
        						alarm ($timeout);
						$what  = IO::Socket::INET->new("$ckl:43") or $added="<b>($ckl) Server is not responding</b>";
						print $what "$this.$that\n";
						@extras=<$what>;
						close $what;
						chop(@extras);
						alarm (0);
						};
					if ($@ eq "timed\n") 
						{	        
						$added="$ckl Server Timed Out";
   						}
					$extras[0]=$added;
					push(@result,"<hr>"); 
					}
                			if ($i =~ /$splitx[2]/ig){$whatis="$this.$that is Available";}
               				}
			return $whatis;
			}
		}
	
	}
	
sub all
	{
	&my_header;
	&start_table;
	print"<tr align=center bgcolor='$list_names'>
	<th  width='$t1'><font color=$list_namest $font>Domain</font></th>
	<th  width='$t2'><font color=$list_namest $font>Result</font></th>
	<th  width='$t3'><font color=$list_namest $font>Action</font></th></tr></table></td></tr></table>";
	$lupe=0;
	foreach $i (@tld)
		{
		@splitz=split(/,/,$i);
		$output=&domainchk($stuff{'command'},$splitz[0]);
		if($output eq "$stuff{'command'}.$splitz[0] is Unavailable")
			{
			&start_table;
			$isit[$lupe]="<tr align=center bgcolor='$unavailable'><td  width='$t1' ><a href='http://www.$stuff{'command'}.$splitz[0]' target='new'><b>$stuff{'command'}.$splitz[0]</b></a></td><td width='$t2'><b>$taken</b></td><td  width='$t3' bgcolor=$extras><a href='$me?command=$stuff{'command'}&type=$splitz[0]'>$details1</a></td></tr>";
			}
		if($output eq "$stuff{'command'}.$splitz[0] is Available")
			{
			&start_table;
			$isit[$lupe]="<tr align=center bgcolor='$available'><td width='$t1'><b>$stuff{'command'}.$splitz[0]</b></td><td width='$t2'><b>$whatnext</b></td><td width='$t3' bgcolor=$extras><a href='$me?command=$stuff{'command'}&type=$splitz[0]'>$details2</a></td></tr>";
			}
		if($output =~ /Server/g)
			{
			&start_table;
			my $tt=$t1+$t2+$t3;
			$isit[$lupe]="<tr align=center bgcolor='$errorbox'><td width='$tt'><font color=$errorboxt $font><b>$stuff{'command'}.$splitz[0]</b> $output</font></td></tr>";
			}
		print "$isit[$lupe]</table></td></tr></table>";
		$lupe++;
		}

	&my_footer;
	}




sub my_header()
{
print<<"[HTML]";
<HTML><head><title>Domain Check</title></head>
<body 	 vlink="$links"
	 alink="$links" 
       bgcolor="$background"
	  link="$links" 
	  text="$text"
     topmargin="20" 
    leftmargin="0"
  marginheight="20" 
   marginwidth="0">
<CENTER>
<form name="defaulter" action="$me" method="post">
[HTML]
&start_table;
print<<"[HTML]";
<tr align=left>
<td bgcolor="$webwhobar" height=15>
<a href="http://www.webwho.co.uk"><font color=$webwhobart $font><b>www.webwho.co.uk</b></a></font>
</td></tr>


<tr align=center valign=middle><td bgcolor="$input_area">
<font color=$input_areat $font><b>www.</b></font>
<INPUT	STYLE="background-color:#ffffff" 
	TYPE="text" 
	NAME="command" 
	SIZE="25" 
	MAXLENGTH="60" 
	VALUE=$stuff{'command'}>

<select STYLE="background-color:#ffffff" NAME="type" SIZE="1">
[HTML]
print "<option";

if ($stuff{'type'} eq $alltext){print " selected";}
	print ">$alltext</option>";
foreach $i (@tld)   
	{
	@splitz=split(/,/,$i);
	print "<option";
	if ($stuff{'type'} eq $splitz[0]){print " selected";}
	print ">$splitz[0]</option>";
        	}
               
            
                
print<<"[HTML]";               
</select>

$submit_form</td></tr></table></td></tr></table></form>
[HTML]
}

sub start_table
{
print<<"[HTML]"; 
<table width="$tw" border=0 bgcolor="black" cellspacing=0 cellpadding=0><tr valign=middle align=center><td valign=middle align=center><table border="0" cellpadding="0" cellspacing="$border" width="100%">
[HTML]
}

sub showone
{
&start_table;
print "<tr bgcolor='black'><td bgcolor='$list_names'>";
print "<font size=2 $font color=$list_namest><b> $output<br></b></font></td></tr><tr bgcolor='black'><td bgcolor='$details'><font size=2 $font color=$detailst>";


if($stuff{'type'} eq "biz")
	{
	my $dummy=join("<br>",@result);
	($what,$lupe)=split(/OF THE AVAILABILITY OF A DOMAIN NAME./,$dummy);
	print "$lupe<hr>$what OF THE AVAILABILITY OF A DOMAIN NAME.";
	}
	else
	{
	foreach $i (@result)
		{
		print "$i<br>";
		}
	foreach $i (@extras)
		{
		print "$i<br>";
		}
	}
	print "</b></font></td></tr></table></td></tr></table>\n";

}
sub my_footer
{
print<<"[HTML]";  
</body></html>
[HTML]
}


############################
# Whoopsydaisy
sub fatal_error()
{
&my_header;
&start_table;
print<<"[HTML]";
<tr bgcolor='black' align=center>
<th colspan=3 bgcolor=red><font color=white  $font>$_[0]</font></th>
</tr>

</table></td></tr></table></center></BODY></HTML>

[HTML]
&my_footer;
exit;
}