webwho
#!/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;
}
Добавлено: 15 Августа 2020 04:02:37 Добавил: Андрей Ковальчук