#!/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; }