whois cgi script

[robin roos]

Hi, I have this script running that only checks com/net/org .
When I try to make it check domains in the netherlands by declaring domain,
region and lookup url: "nl", "dutch", "whois.domain-registry.nl" it somehow
ignores it. It tried several options like changing &defaulttld in "nl",
declaring "nl" as an american region etc.. It either checks com/net/org or
just nl but doesn't do both. Can someone figure out in this small script how
to make it work for com/net/org/nl?

THE SCRIPT:

#!/usr/bin/perl
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#
# #
# _____ _ _ _ _ _ _ __ _ _ #
# | | |___| |_| | | | |_ ___|_|___ | | |_| |_ ___ #
# | | | | -_| _| | | | | . | |_ -| | |__| | _| -_| #
# |_|___|___|_| |_____|_|_|___|_|___| |_____|_|_| |___| #
# #
# #
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#
# NetWhois Lite v1.0 Copyright 2000 Dale Emmons 6.1.00 #
# All Rights Reserved. #
# #
# You can find more of my stuff at http://dale.emons.com/perl/ #
# #
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#
# LICENSE AGREEMENT #
# #
# Any and all use of this product, in whole or in part, is subject to #
# and signifies agreement to the terms set forth in the End User License #
# Agreement that is referenced at #
# http://dale.emons.com/perl/netwhois_lite/license.html. For your #
# reference, a copy of the above mentioned license is provided as part #
# of this distribution in a file called LICENSE.TXT. In the event a #
# discrepancy exists between the license contained on our web site and #
# the license accompanying this software, the license contained on our web #
# site shall be deemed authoritative. #
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#
# INCLUDED FILES #
# #
# whois.cgi This file, the one that holds all of the script that #
# makes everything work. #
# whoistemplate.html Used by whois.cgi to format output. #
# install.txt Holds instructions and other information about this #
# product. #
# license.txt Holds license information. #
# #
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#

# url of this script
my $scriptLocation = "http://www.dominodata.nl/cgi-bin/whois.cgi";

# location of the template file relative to this script
my $template = "whoistemplate.html";

# page that you want the registration link to go to
my $registerPage = "/register.html";

# in the template file, the string that will be replaced with this script's
output
# note: backslashes must be before the carrot (^) sign here, but are not in
the template file
my $resultsReplaceString = '<\^results\^>';

# font info for the results
my $fontInfo = '<font size="3" face="Verdana, Arial, Helvetica,
sans-serif">';

# when not whois checks are issued to the script (ie, when a visitor first
comes to the
# script, the script will display the following text. Usually along the
lines of
# 'check if your domain is availabel'
my $defaultString = "Check to see if your domain is available!";

# again, when visitor first comes, there will be a default domain already in
the text
# box. usually along the lines of 'your-domain'. Can be left blank.
my $defaultDomain = "your-domain";

# the default top level domain (eg. com, net, org, etc.)
my $defaultTLD = "com";

#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#
# No editing is necessary past this point. #
#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
^^^^#

use IO::Socket;
use strict;
use CGI;

my @TLDs = ("com" , "american" ,
"net" , "american" ,
"org" , "american" ,
"nl" , "dutch" );

# region domain doesn't exist string test server whois results
server
my @TLDservers = ( "american" , "No match for" , "whois.crsnic.net" ,
"whois.networksolutions.com" ,
"dutch" , "No match for" , "whois.domain-registry.nl" ,
"whois.domain-registry.nl" );

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

# setup timeout signal
$SIG{ALRM} = sub {printPage("$fontInfo Operation timed out.</font>")};

printPage(main());

sub main {
# get CGI stuff
my $query = new CGI;
my $domain = $query->param('domain');
my $TLD = $query->param('tld');
my $whoisDomain = $query->param('whois');
if ($whoisDomain) {
($domain, $TLD) = split(/\./, $whoisDomain);
$whoisDomain = 1;
} else {
$whoisDomain = 0;
}

my ($output, $possibleTLD);

# if $domain has a TLD at the end and is valid, use that. otherwise dump
it.
if ($domain =~ /\./isg) {
$possibleTLD = $domain;
$possibleTLD =~ s/^.*\.//isg;
my $i;
for ($i=0;$i<@TLDs;$i+=2) {
if ($TLDs[$i] eq $TLD) {
$TLD = $possibleTLD;
}
}
$domain =~ s/\..*//isg;
}
# don't want a whois or a check (ie: first visit) so trigger printing of
std. page.
my $defaultPage = 0;
if (!$domain) {
$TLD = $defaultTLD;
$domain = $defaultDomain;
$defaultPage = 1;
}

# determins $TLD 's region
my ($i, $TLDRegion);
for ($i=0;$i<@TLDs;$i+=2) {
if ($TLDs[$i] eq $TLD) {
$TLDRegion = $TLDs[$i+1];
}
}

# set server access info based on $TLD's region
my ($TLDsearchString, $TLDtestServer, $TLDwhoisServer);
for ($i=0;$i<@TLDservers;$i+=4) {
if ($TLDservers[$i] eq $TLDRegion) {
$TLDsearchString = $TLDservers[$i+1];
$TLDtestServer = $TLDservers[$i+2];
$TLDwhoisServer = $TLDservers[$i+3];
}
}
# searches all domain/region pairs of @TLDs for ones that match $TLDRegion,
except $TLD,
# and assigns them to @TLDsInRegion
my @otherTLDsInRegion;
for ($i=1;$i<@TLDs;$i+=2) {
if ($TLDs[$i] eq $TLDRegion) {
@otherTLDsInRegion = (@otherTLDsInRegion, $TLDs[$i-1]) unless
($TLDs[$i-1] eq $TLD);
}
}

# if this is a simple whois query, call getWhois() and print the results to
printPage().
if ($whoisDomain) {
return $fontInfo."<BR><BR><font
size=1>".getWhois("$domain.$TLD",$TLDwhoisServer)."</font></font><BR><BR>";
}

# check if domain contains illegal characters, etc. and say so if it is
if (!checkCharacters($domain))

$output = makeForm($domain,$TLD,@otherTLDsInRegion).$fontInfo."<br>The
domain \"$domain.$TLD\" contains illegal charactors.<br>Domains cannot begin
or end with a dash, may only contain a-z, 0-9 and hyphens, and must be 26
characters or less.</font>";
return $output;

# good domain (syntax), let's do the check.
} else {
if ($defaultPage) {
$output = $fontInfo.$defaultString;
}
$output = $output.makeForm($domain,$TLD,@otherTLDsInRegion).$fontInfo;
my $registerIt="";
if ($registerPage) {
$registerIt = "<a href=\"$registerPage\">Click here</a> to register
it!<br>";
}
if (!$defaultPage) {
if (!$TLD)

$output = $output.'Not a valid top level domain. Please go back and try
again.';
return $output;
}

my $also = "also";
if (checkAvailable("$domain.$TLD",$TLDtestServer,$TLDsearchString)) {
$output = $output."\"$domain.$TLD\" is available!<br>$registerIt<br>";
} else {
$output = $output."\"$domain.$TLD\" is not available.<br><font
size=\"1\"><a href=\"$scriptLocation?whois=$domain.$TLD\">Click here to see
it's whois record.</a></font><br><br>";
$also = "";
}

foreach $i (@otherTLDsInRegion) {
if (checkAvailable("$domain.$i",$TLDtestServer,$TLDsearchString)) {
$output = $output."\"$domain.$i\" is $also
available!<br>$registerIt<br>";
}
}
}
$output = $output.'</font>';
return $output;
}
}

# takes info to replace $resultsReplaceString with in $template and prints
it
sub printPage {
my $output = $_[0];
open(TEMPLATE,"$template") or die "Couldn't open template file,
\"$template\": $!";
foreach (<TEMPLATE>) {
my $line = $_;
#replace stuff from each line, as needed.
$line =~ s/($resultsReplaceString)/$output/isg;
print $line;
}
close TEMPLATE;
exit;
}

# creates the search form using the domain and TLD.
sub makeForm {
my ($domain, $TLD, @otherTLDsInRegion) = @_;
my $output = '<form method="get"
action="'.$scriptLocation.'">'.$fontInfo.'www.<input type="text"
name="domain" value="'.$domain.'">.<select name="tld"><option
value="'.$TLD.'" selected>'.$TLD.'</option>';
my $i="";
foreach $i (@otherTLDsInRegion) {
$output = $output.'<option value="'.$i.'">'.$i.'</option>';
}
$output = $output.'</select><input type="submit" name="Go!"
value="Go!"><font size="1"><br><a
href="http://dale.emmons.com/perl/netwhois_lite/">NetWhois Lite
v1.0</a></font></font></form>';
return $output;
}

# connects to a whois database through Net::Whois (or Whois.pm) and checks
if a domain
# is available. if it is: returns 1. if not: 0.
sub checkAvailable {
alarm 10;
my $input = $_[0];
my $TLDtestServer = $_[1];
my $TLDsearchString = $_[2];
# sleep 6;
my $port = "43";
my $next = "\015\012";
my $socket = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>$TLDtestServer,
PeerPort=>$port,);

unless ($socket) {die $input, $@; }

print $socket "$input" . $next;
my $line;
foreach $line (<$socket>) {
if ($line =~ /$TLDsearchString/) {
alarm 0;
return 1;
}
}
close $socket;
alarm 0;
return 0;
}

# tests string if valid for a domain name. if valid: returns 1; otherwise:
0.
sub checkCharacters {
my $testString = $_[0];

if ($testString > 26) {
return 0;
}

# fails of domain starts or ends with a hyphens
if ($testString =~ /^-/isg || $testString =~ /-$/isg) {
return 0;
}

# otherwise, delete hyphens so \W test will work right with a domain
# that has dashes in the middle somewhere
$testString =~ s/-//isg;
if ($testString =~ /\W/isg || $testString =~ /\_/isg) {
return 0;
} else {
return 1;
}
}

# gets whois information
sub getWhois {
alarm 10;
my $input = $_[0];
my $TLDwhoisServer = $_[1];
my $port = "43";
my $next = "\015\012";
my $socket = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>$TLDwhoisServer,
PeerPort=>$port,);

unless ($socket) {die $input, $@; }

print $socket "$input" . $next;
my @whoisInfo = <$socket>;
close $socket;
my $return = join("",@whoisInfo);
$return =~ s/\n/<br>/isg;
$return =~ s/\ /&nbsp;/isg;
$return =~ s/\t/&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/isg;
alarm 0;
return $return;
}