#!/usr/bin/perl


use Socket;
$| = 1;

%TLD2 = ();
@TLDs = ();

&print_html_header();
&Get_ENV();
&read_config();
&check_required();
do_vars();


 SWITCH: {
     
     ($print_tlds == 1) && do {
	 @TLDs = cdopenfile("$TLD_DATABASE");
	 display_file("tld_table");
	 exit(0);
     };
     ($show_wizard == 1) && do {
	 @TLDs = cdopenfile("$TLD_DATABASE");
	 display_file("wizard");
	 exit(0);
     };
     ($show_global == 1) && do {
	 display_file("global");
	 exit(0);
     };

 }

if ($in{'lookup'} ne "OK") {

    if ($root_allowed == 1 ) {
	display_file("formroot");
	exit(0);
    } else {
	@TLDs = cdopenfile("$TLD_DATABASE");
	display_file("formtld");
	exit(0);
    }

} else {
    @TLDs = cdopenfile("$TLD_DATABASE");    
    if ($wizard_look == 1) {
	($server,$nomatch,$port,$hostip) = check_tld(@TLDs);
	$VALUES{">WHOIS<"} = $server;
	do_wizard_lookup();
    } elsif ($global_look == 1) {
	$ext = "";
	$fqdn = $domain;
	clean_domain();
	do_global();
    }
    get_ext(@TLDs);
    clean_domain();
    ($server,$nomatch,$port,$hostip,$recurse) = check_tld(@TLDs);
    $VALUES{">WHOIS<"} = $server;
    do_whois($fqdn,$server,$nomatch,$port,$hostip,$recurse);
    exit(0);
}

sub do_vars {

    $attempts = 1;
    $maxtries = 20;
    $root_allowed = $in{'root_allowed'};
    $print_tlds = $in{'print_tlds'};
    $show_wizard = $in{'show_wizard'};
    $wizard_look = $in{'wizard_look'};
    $show_global = $in{'show_global'};
    $global_look = $in{'global_look'};
    $raw = $in{'raw'};
  

    $service = ""; $keyword1 = ""; $keyword2 = "";
    $service = $in{'service'};
    $keyword1 = $in{'keyword1'};    
    $keyword2 = $in{'keyword2'};
    $service =~ s/\s+//g;
    $keyword1 =~ s/\s+//g;
    $keyword2 =~ s/\s+//g;

    if ($root_allowed == 1) {
	$ext = $domain = $fqdn = $in{'domain'};
       	$domain =~ s/\..+//g;
	$ext =~ s/^.+?\.//g;
    } else {
	$domain = $in{'domain'};
	$ext = $in{'ext'};
	$fqdn = $domain . "." . $ext;
    }

}

sub clean_domain {
    
    local($cdomain);

    $fqdn =~ s/\s+//g;
    $domain =~ s/\s+//g;
    $ext =~ s/\s+//g;
    $tld = $ext;
    $tld =~ s/^.+\.//g;

    $VALUES{">TLD<"} = $tld;
    $VALUES{">2LD<"} = $domain;
    $VALUES{">EXT<"} = $ext;
    $VALUES{">FQDN<"} = $fqdn;

    # we can count on only one '.' in $domain
    if ($root_allowed != 1) {
	@FLDS = split('\.',$domain);
	if ($#FLDS > 0) {
	    # newbie alert!
	    if ($domain =~ /^www\./) {
		$domain =~ s/^www\.//g;
		$fqdn = $domain . "." . $ext;
	    } else {
		# we must bail
		$VALUES{">ERRMSG<"} = "Too many levels of domain";
		display_file("uerror");
		exit(0);
	    }
	}
    } else {
	# a little bit trickier, we have to take a pot shot and
	# hope check_tld() will pick us up later
	@FLDS = split('\.',$fqdn);
	if (defined($TLD2{$tld})) {
	    $maxdot = 2;
	} else {
	    $maxdot = 1;
	}
	while ($#FLDS > $maxdot) {
	    if ($fqdn =~ /^www\./) {
		$fqdn =~s/^www\.//g;
		$ext = $domain = $fqdn;
		$domain =~ s/\..+//g;
		$ext =~ s/^.+?\.//g;
	    } else {
		# we must bail
		$VALUES{">ERRMSG<"} = "Too many levels of domain";
		display_file("uerror");
		exit(0);
	    }
	    @FLDS = split('\.',$fqdn);
	}
	
    }


    $tld = $ext;
    $tld =~ s/^.+\.//g;


    $l = length($fqdn);
    if ( ($l > 10) || ( $l == 8) || ($l == 7) || ($l <= 5) ){
	$fqdn =~ s/^www\.//;
	if ($root_allowed == 1) {
	    $ext = $domain = $fqdn;
	    $domain =~ s/\..+//g;
	    $ext =~ s/^.+?\.//g;
	}
	
    }


    $VALUES{">TLD<"} = $tld;
    $VALUES{">2LD<"} = $domain;
    $VALUES{">EXT<"} = $ext;
    $VALUES{">FQDN<"} = $fqdn;


    $cdomain = $fqdn;
    
    # Check for "-" in the beginning or end of the domain
    if ($cdomain =~ /^-|-$/) {
	$VALUES{">ERRMSG<"} = "Illegal Character Placement: $fqdn: "
	    . "\"-\" located at beginning or end";
	display_file("uerror");
	exit(0);
    }

    # Remove the "-" character since its allowed and it won't cause an
    # an error when we check for non word characters below
    $cdomain =~ s/-//g;
    $cdomain =~ s/\.//g;

    
    # Perform some simple checks to make sure there's no bad characters
    if ($cdomain =~ /_/) {
	$VALUES{">ERRMSG<"} ="Illegal Character in Domain: $fqdn: " .
	    "underscore (_) not permitted in domains.";
	display_file("uerror");
	exit(0);
    } 
    if ($cdomain =~ /\W/) {
	$VALUES{">ERRMSG<"} ="Illegal Character: $fqdn: " .
	    "Illegal character in domain.";
	display_file("uerror");
	exit(0);
    } 
    if ($cdomain eq "") {
	$VALUES{">ERRMSG<"} ="NO DOMAIN ENTERED.";
	display_file("uerror");
	exit(0);
    }
    
}

sub get_ext {

    local(@TLDs) = @_;

    foreach $record (@TLDs) {
	@FLDS = split('\|',$record);
	if($FLDS[0] =~ /\./) {
	    $tldtemp = $FLDS[0];
	    $tldtemp =~ s/^.+\.//g;
	    $TLD2{$tldtemp} = "1";
	}
    }
}
	   

sub check_tld {
    local (@TLDs) = @_;
    local($server, $nomatch, $found, $tfile, $record, $port, $hostip, $recurse);
    @exts = ();

    $found = 0;
    $tfile = $ROOT_DIR . $TLD_DATABASE;

    if ($ext eq "xxx") {
	$VALUES{">ERRMSG<"} = "You MUST select a Top Level Domain!";
	display_file("uerror");
	exit(0);
    }

    @FLDS = split('\.',$fqdn);
    $nfields = $#FLDS;
    if ($nfields < 1) {
	$VALUES{">ERRMSG<"} = "You MUST select a Top Level Domain!";
	display_file("uerror");
	exit(0);
    } 
    
    foreach $record (@TLDs) {
	chomp($record);
	@rfields = split('\|',$record);
	if ($rfields[0] =~ /$tld$/) {
	    $tvar = $domain . "." . $rfields[0] . 
		"\t" . "(" . $rfields[3] . " Only)";
	    push(@exts,$tvar);
	}
	if ($rfields[0] =~ /^$ext$/i) {
		$server = $rfields[1];
		$nomatch = $rfields[2];
		$port = ($rfields[5] =~ /[0-9]/) ? $rfields[5] : 43;
		$hostip = ("\L$rfields[6]" eq "hostip") ? 1 : 0;
		$recurse = ("\L$rfields[7]" eq "recurse") ? 1 : 0;
		$found = 1;
		last;
	    }
    }

    if ($found == 0) {
	if (@exts) {
	    foreach $ent (@exts) {
		if ($ent !~ /\..+\./)  {
		    $VALUES{">ERRMSG<"} = 
			"The extension <b>$ext</b> is not supported " .
			    "or too many levels of domain in $fqdn.\n";
		    display_file("uerror");
		    exit(0);
		} else {
		    display_file("tldhelp");
		    exit(0);
		}
	    }
	} else {
	    $VALUES{">ERRMSG<"} = 
		"The extension <b>$ext</b> is not supported.";
	    display_file("uerror");
	    exit(0);

	}
    }
    return ($server,$nomatch,$port,$hostip,$recurse);
    
}


sub do_whois {

    local ($fqdn,$server,$nomatch,$port,$hostip,$recurse) = @_;
    local ($used);

    @result = &get_whois($fqdn,$server,$port,$hostip);



    if ($raw == 1) {
	if ($recurse) {
		foreach (@result) 
		{
			if (/Registrar:\s(.*)/) { $registrar = $1 }
			if (/Whois Server:\s(.*)/) { $newserver = $1 }
		}
		if ($newserver) {
			$VALUES{">WHOIS<"} = "$newserver ($registrar)";
			@result=get_whois($fqdn,$newserver,$port,$hostip);
		}
	}
	display_file("raw");
	exit(0);
    }
    $used = 1;
    foreach (@result) {
	if (/$nomatch/) {
	    $used = 0;
	    last;
	} elsif (/^\*/) {
	    $attempts++;
	    sleep(1);
	    if ($attempts > $maxtries) {
		$VALUES{">TITLE_BAR<"} = "InterNIC DOWN";
		($TEMPLATES{"header"}) && &do_file("header");
		&internic_down($fqdn);
		($TEMPLATES{"footer"}) && &do_file("footer");
		exit(0);
	    }  
	} elsif (/ERROR/) {
	    $VALUES{">ERRMSG<"} = "I cannot connect to $server on port $port.";
	    display_file("uerror");
	    exit(0);
	}
    }
    if ($used == 1) {
	display_file("used");
	exit(0);
    } else {
	display_file("avail");
	exit(0);
    }
}


sub get_whois {
	local($fqdn,$server,$port,$hostip) = @_;
	local(@result,$sin,$len,$offset,$written,$buff,$myfqdn);
        socket(SOCK, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]) || 
	    return ((""));
	$sin = sockaddr_in($port, inet_aton($server));
	  connect(SOCK, $sin) || return (("CDERROR: SOCKET ERROR PORT: $port SERVER: $server"));
	$offset = 0;
	if ($hostip) {
		$buff = "$ENV{'REMOTE_HOST'} $ENV{'REMOTE_ADDR'} $fqdn \r\n";
	} else {
		$buff = $fqdn . "\r\n";
	}
	$len = length($buff);
	while($len) {
		$written = syswrite(SOCK,$buff,$len,$offset);
		$len -= $written;
		$offset += $written;
	}
	
	@result=<SOCK>;
	close(SOCK);
   return(@result);
}

sub global_out {
    #DANGER
    local(@FLDS);
    foreach $record (@TLDs) {
	chomp($record);
	@FLDS = split('\|',$record);
	if (($FLDS[0] !~ /^sp/) && ($FLDS[4] == 1)) {
	    $server = $FLDS[1];
	    $gdomain = $domain . "." . $FLDS[0];
            $port = ($FLDS[5] =~ /[0-9]/) ? $FLDS[5] : 43;
            $hostip = ("\L$FLDS[6]" eq "hostip") ? 1 : 0;
	    
	    @result = &get_whois($gdomain,$server,$port,$hostip);
	    $GLOBAL{$gdomain} = 1;
	    foreach (@result) {
		if (/$FLDS[2]/) {
		    $GLOBAL{$gdomain} = 0;
		    last;
		} elsif (/CDERROR/) {
		    $GLOBAL{$gdomain} = -1;
#		    print "<b>error: $gdomain @result<p></b>\n";
		}
		    
	    }
	}
    }
    foreach $dom (sort (keys %GLOBAL)) {
	if ($GLOBAL{$dom} == 1) {
	    push(@USED,$dom);
	} elsif ($GLOBAL{$dom} == 0) {
	    push(@AVAIL,$dom);
	}
    }
    $loop = ($#USED > $#AVAIL) ? $#USED : $#AVAIL;
    print("<table border=0 width=\"100%\">\n");
    print("<tr>\n");
    print("<td width=\"50%\" align=\"center\">\n");
    print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
    print("<b>The following domains are unavailable:</B>\n");
    print("</font>\n");
    print("</td>");
    print("<td width=\"50%\" align=\"center\">\n");
    print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
    print("<b>The following domains are available:\n</b>");
    print("</font>\n");
    print("</td>");
    print("</tr>");
    print("<tr><td colspan=2><hr></td></tr>\n");
    
    for ($count == 0; $count <= $loop; $count++ ) {
	$avail = ""; $used = "";
	$avail = pop(@AVAIL);
	$used = pop(@USED);
	print("<tr>\n");
	print("<td width=\"50%\" align=\"center\">\n");
	print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
	print("$used\n");
	print("</font>\n");
	print("</td>");
	print("<td width=\"50%\" align=\"center\">\n");
	print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
	if ($ORDER_FORM) {
	    print("<A HREF=\"$ORDER_FORM?domain=${avail}\">$avail</a>\n");
	} else {
	    print("$avail\n");
	}
	print("</font>\n");
	print("</td>");
	print("</tr>");
    }
    print("</table>\n");
}

sub do_global {

    if ($domain eq "") {
	$VALUES{">ERRMSG<"} = "Wizard Search: You must fill in at least " .
	    "one of the fields";
	display_file("uerror");
	exit(0);
    }
    $domain =~ s/\s+//g;
    display_file("globres");
    exit(0);
}

sub do_wizard_lookup {

    if ( ($service eq "") && ($keyword1 eq "") && ($keyword2 eq "")) {
	$VALUES{">ERRMSG<"} = "Wizard Search: You must fill in at least " .
	    "one of the fields";
	display_file("uerror");
	exit(0);
    }
    

    display_file("wizres");
    exit(0);

}

sub wizard_out {

    local(@first,@second);
    $FONT_NAME = $FONTS{"text"};
    $FONT_SIZE = $FONTS{"size"};

    $first[0] = $second[0] = $service;
    $first[1] = $second[1] = $keyword1;
    $first[2] = $second[2] = $keyword2;


    for ($f = 0; $f<= 2; $f++) {
	if ($first[$f] ne "") {
	    $WIZARD{"$first[$f].$ext"} = -1;
	}
        for ($s = 0; $s <= 2; $s++ ) {
	    if ($f != $s) {
		
		if (($first[$f] ne "") && ($second[$s] ne "")) {
		    $WIZARD{"$first[$f]$second[$s].$ext"} = -1;
		}
		if (($first[$f] ne "") && ($second[$s] ne "")) {
		    $WIZARD{"$first[$f]-$second[$s].$ext"} = -1;
		}
	    }
        }
    }
    whoizit($server,$nomatch,$port,$hostip);
    foreach $dom (keys %WIZARD) {
	if ($WIZARD{$dom} == 1) {
	    push(@USED,$dom);
	} else {
	    push(@AVAIL,$dom);
	}
    }
    $loop = ($#USED > $#AVAIL) ? $#USED : $#AVAIL;
    print("<table border=0 width=\"100%\">\n");
    print("<tr>\n");
    print("<td width=\"50%\" align=\"center\">\n");
    print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
    print("<b>The following domains are unavailable:</B>\n");
    print("</font>\n");
    print("</td>");
    print("<td width=\"50%\" align=\"center\">\n");
    print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
    print("<b>The following domains are available:\n</b>");
    print("</font>\n");
    print("</td>");
    print("</tr>");
    print("<tr><td colspan=2><hr></td></tr>\n");
    
    for ($count == 0; $count <= $loop; $count++ ) {
	$avail = ""; $used = "";
	$avail = pop(@AVAIL);
	$used = pop(@USED);
	print("<tr>\n");
	print("<td width=\"50%\" align=\"center\">\n");
	print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
	print("$used\n");
	print("</font>\n");
	print("</td>");
	print("<td width=\"50%\" align=\"center\">\n");
	print("<font face=\"$FONT_NAME\" size=\"$FONT_SIZE\">\n");
	if ($ORDER_FORM) {
	    print("<A HREF=\"$ORDER_FORM?domain=${avail}\">$avail</a>\n");
	} else {
	    print("$avail\n");
	}
	print("</font>\n");
	print("</td>");
	print("</tr>");
    }
    print("</table>\n");
    
}

sub whoizit {

    local ($server,$nomatch,$port,$hostip) = @_;

    foreach $wdomain (keys %WIZARD) {
	@result = ();
	@result = &get_whois($wdomain,$server,$port,$hostip);
	$used = 1;
	foreach (@result) {
	    if (/$nomatch/) {
		$used = 0;
		last;
	    } elsif (/CDERROR/) {
		$used = "-1";
	    }
		    
	}
	$WIZARD{$wdomain} = $used;
    }
}


sub raw_whois {

		print("<PRE>\n");
		print @result;
		print("</PRE>\n");
#	} else {
	# this is a recursive search
#		foreach (@result) 
#		{
#			if (/Registrar:\s(.*)/) { $registrar = $1 }
#			if (/Whois Server:\s(.*)/) { $newserver = $1 }
#		}
#		$VALUES{">WHOIS<"} = "$newserver ($registrar)";
#		@result=get_whois($fqdn,$newserver,$port,$hostip);
#              	print("<PRE>\n");
#                print @result;
#       	        print("</PRE>\n");
#	}
}




sub ext_list {

    foreach $item (@exts) {
	print("<B>$item</B><br>\n");
    }
}


sub display_file {

    local($file) = @_;

    $VALUES{">TITLE_BAR<"} = $MSG{"$file"};

    ($TEMPLATES{"header"}) && &do_file("header");
    do_file($file);
    ($TEMPLATES{"footer"}) && &do_file("footer");

}
sub do_file {

    local($mode) = @_;
    local(@FILE,$FILE);



      @supported = (">CDOMAIN<",
	     ">REFERER<",
	     ">TLD_LIST<",
	     ">TLD_LIST_TABLE<",
	     ">TLD<",
	     ">RAW_WHOIS<",
	     ">WHOIS<",
	     ">FQDN<",
	     ">2LD<",
	     ">EXT<",
	     ">EXT_LIST<",
	     ">ERRMSG<",
	     ">WIZARD_URL<",
	     ">WIZARD_OUT<",
 	     ">GLOBAL_URL<",
	     ">GLOBAL_OUT<",
	     ">SCRIPT_ROOT",
	     ">SCRIPT<",
	     ">SCRIPT_TLD<",
	     ">TITLE_BAR<",
	     ">ORDER_FORM<" );

  SWITCH: {

      ($mode =~ /tld_table/) && do {
	  @supported = (">CDOMAIN<",'>TLD_LIST<',
			'>TLD_LIST_TABLE<',">TITLE_BAR<",
			">REFERER<",">SCRIPT<");
	  last SWITCH;
      };

      ($mode =~ /uerror/) && do {
	  @supported = (">CDOMAIN<",
			">TITLE_BAR<",
			">ERRMSG<",
			">FQDN<",
			">2LD<",
			">EXT<",
			">TLD<",
			">REFERER<");

	  last SWITCH;
      };

  }      



    if (defined($TEMPLATES{$mode})) {
	$FILE = $TEMPLATES{$mode};
    } else {
	script_error("Call to display $mode but $mode not defined in cfg");
    }

    @FILE = cdopenfile($FILE);
    foreach (@FILE) {
	foreach $exp (@supported) {
	    if (/\[$exp\]/i) {
		if (defined($FUNCTIONS{"\U$exp"})) {
		    s/\[$exp\]//g;
		    $function = $FUNCTIONS{"\U$exp"};
		    &$function;
		} else {
		    s/\[$exp\]/$VALUES{"\U$exp"}/g;
		}
	    } 
	}
	if (/\[>include\s+(\S+)<\]/i) {
	    $INCLUDE_FILE = $1;
	    s/\[>[iI].+\]//g;
	    @INCLUDE = cdopenfile($INCLUDE_FILE);
	    foreach $line (@INCLUDE) {
		print $line;
	    }
	}
	print;
    }
}    

sub cdopenfile {

    local($file) =  @_;
    local(@FILE);

    $tfile = $ROOT_DIR . $file;

    open(FILE,"<$tfile") or script_error("Cant open $file\n $!");
    @FILE = <FILE>;
    close(FILE);
    return (@FILE);

}


sub Get_ENV {
# The following code snippet was taken from cgi-lib.pl and is
# Copyright (c) 1995 Steven E. Brenner  

  local ($i, $key, $val, $arglist);

  if ($ENV{'REQUEST_METHOD'} eq "GET") {
	$in = $ENV{'QUERY_STRING'};
  } else {
	read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }

  @in = split(/[&;]/,$in); 

  foreach $i (0 .. $#in) {
    $in[$i] =~ s/\+/ /g;
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
    $key =~ s/%(..)/pack("c",hex($1))/ge;
    $val =~ s/%(..)/pack("c",hex($1))/ge;
    $in{$key} .= "\0" if (defined($in{$key})); 
    $in{$key} .= $val;

  }

  return scalar(@in); 
}


sub read_config {

#DEFAULTS:
    if ( ( defined( $ENV{'SERVER_NAME'} ) ) 
	 && ( defined( $ENV{'REQUEST_URI'} )) ) {
	$SCRIPT_URL = "http://" . $ENV{'SERVER_NAME'} . $ENV{'REQUEST_URI'};
    } 

    if ( ( defined( $ENV{'HTTP_REFERER'} ) )) {
	$REFERER = $ENV{'HTTP_REFERER'};
    }

    $FUNCTIONS{">TLD_LIST<"} = "tld_list";
    $FUNCTIONS{">TLD_LIST_TABLE<"} = "tld_list_table";
    $FUNCTIONS{">EXT_LIST<"} = "ext_list";
    $FUNCTIONS{">RAW_WHOIS<"} = "raw_whois";
    $FUNCTIONS{">WIZARD_OUT<"} = "wizard_out";
    $FUNCTIONS{">GLOBAL_OUT<"} = "global_out";

    open(CONFIG,"<cdomain.cfg") or script_error("Cannot open config file");
    while (<CONFIG>) {
	next if /^#/;
	next if /^\s+/;
	SWITCH: {

	    /root_dir\s+(\S+)/i && do {
		$ROOT_DIR = $1;
		last SWITCH;
	    };

	    /script_url\s+(\S+)/i && do {
		$SCRIPT_URL = $1;
		last SWITCH;
	    };
	    /log_file\s+(\S+)/i && do {
		$LOG_FILE = $1;
		last SWITCH;
	    };

	    /tld_database\s+(\S+)/i && do {
		$TLD_DATABASE = $1;
		last SWITCH;
	    };

	    /order_url\s+(\S+)/i && do {
		$ORDER_FORM = $1;
		$VALUES{">ORDER_FORM<"} = $ORDER_FORM;
		last SWITCH;
	    };
	    
	    /template\s+(\S+)\s+(\S+)/i && do {
		$tname = lc($1);
		$tfile = $2;
		$TEMPLATES{$tname} = $tfile;
		last SWITCH;
	    };

	    /font\s+(\S+)\s+(".+")/i && do {
		$ftype = lc($1);
		$fname = $2;
		$fname =~ s/\"//g;
		$FONTS{$ftype} = $fname;
		last SWITCH;
	    };

	    /color\s+(\S+)\s+(\S+)/i && do {
		$tname = lc($1);
		$tcolor = $2;
		$COLORS{$tname} = $tcolor;
		last SWITCH;
	    };
	    /msg\s+(\S+)\s+(".+")/i && do {
		$mname = lc($1);
		$mval = $2;
		$mval =~ s/\"//g;
		$MSG{$mname} = $mval;
		last SWITCH;
	    };
	    /([\s\S]+)/ && do {
		$error = $1;
		chomp ($error);
		print "Unknown keyword or syntax error: $error\n";
		last SWITCH;
	    };

	}
    }

    if ($SCRIPT_URL) {
        $VALUES{">SCRIPT<"} = $SCRIPT_URL;
    }


    if ($VALUES{">SCRIPT<"} =~ /\?/) {
	$VALUES{">SCRIPT_ROOT<"} = $SCRIPT_URL . "&root_allowed=1";
	$VALUES{">SCRIPT_TLD<"} = $SCRIPT_URL . "&print_tlds=1";
	$VALUES{">WIZARD_URL<"} = $SCRIPT_URL . "&show_wizard=1";
	$VALUES{">GLOBAL_URL<"} = $SCRIPT_URL . "&show_global=1";
	
    } else {
	$VALUES{">SCRIPT_ROOT<"} = $SCRIPT_URL . "?root_allowed=1";
	$VALUES{">SCRIPT_TLD<"} = $SCRIPT_URL . "?print_tlds=1";
	$VALUES{">WIZARD_URL<"} = $SCRIPT_URL . "?show_wizard=1";
	$VALUES{">GLOBAL_URL<"} = $SCRIPT_URL . "?show_global=1";
    }
    $VALUES{">SCRIPT<"} =~ s/\?print_tlds=1//g;
    $VALUES{">SCRIPT<"} =~ s/\&print_tlds=1//g;
    $VALUES{">SCRIPT<"} =~ s/\?show_wizard=1//g;
    $VALUES{">SCRIPT<"} =~ s/\&show_wizard=1//g;
    $VALUES{">SCRIPT<"} =~ s/\?show_global=1//g;
    $VALUES{">SCRIPT<"} =~ s/\&show_global=1//g;

    if ($REFERER) {
	    $VALUES{">REFERER<"} = $REFERER;
    } else {
            $VALUES{">REFERER<"} = $VALUES{">SCRIPT_URL<"};
    }

    $VALUES{">CDOMAIN<"} = 
	"<A HREF=\"http://www.cdomain.com/\">CdomainPro 4.1</A>";


}


# Check that we have what we need. This could probably be done with stat()

sub check_required {

    $tfile = $ROOT_DIR . $TLD_DATABASE;
    open(TEST,"<$tfile") or 
	script_error("Cannot open file $tfile.\nCheck root_dir in config");
    close(TEST);

    if($LOG_FILE) {
	$tfile = $ROOT_DIR . $LOG_FILE;
	open(TEST,"<$tfile") or 
	script_error("Cannot open file $tfile.\nCheck root_dir in config");
	close(TEST);
    }

    foreach $file (keys %TEMPLATES) {
	$tfile = $ROOT_DIR . $TEMPLATES{$file};
	open(TEST,"<$tfile") or 
	    script_error("Cannot open file $tfile.\nCheck root_dir in config");
	close(TEST);
    }


}

#----------------------------------------------------------------
# print_html_header
# 
# prints initial HTML header -- required
#----------------------------------------------------------------

sub print_html_header {
	print ("Content-Type:text/html\n\n");
}

sub tld_list {

    print ("<select name=\"ext\" size=\"-1\">\n");
    print ("<option selected value=\"xxx\">Select</option>\n");

    foreach $record (@TLDs) {
	chomp($record);
	@rfields = split('\|',$record);
	if($rfields[0] eq "sp") {
	    print("<option value=\"xxx\">$rfields[1]\n");
	} else {
	    print("<option value=\"$rfields[0]\">");
	    print("<b>.$rfields[0] $rfields[3]</b>\n");
	}
    }


    print("</select>\n");

}

sub tld_list_table {

    local($TEXT_FONT) = $FONTS{"text"} ? $FONTS{"text"} : "Arial";
    local($TEXT_FONT_SIZE) = $FONTS{"size"} ? $FONTS{"size"} : "-1";
    local($BGCOLOR) = $COLORS{"tld_bgcolor"} ? 
	$FONTS{"tld_bgcolor"} : "#80FFFF";

print <<EOM;
<center><br><br>
<table border=1>
EOM
    $count = 2;
    foreach $record (@TLDs) {
	next if ($record =~ /^sp\|/);
        chomp($record);
        @rfields = split('\|',$record);
	if ($count % 2 == 0) {
	    print("<tr bgcolor=\"$BGCOLOR\">\n");
	} else {
	    print("<tr>\n");
	}
	++$count;

	print("<td>\n");

	print("\t<FONT FACE=\"$TEXT_FONT\" SIZE=\"$TEXT_FONT_SIZE\">\n");

	print("\t.<b>$rfields[0]</b>\n\t</font></td>\n");
	print("<td>\n");
	print("\t<FONT FACE=\"$TEXT_FONT\" SIZE=\"$TEXT_FONT_SIZE\">\n");	
	print("\t$rfields[3]</font>\n</td>\n");
	print("</tr>\n");
    }
print <<EOM;
</table>
</center>
</font>
</blockquote>
EOM


    
}

sub script_error {
    local ($error) = @_;
    print("</td></tr></td></tr></table></table></table>");
    print("<B>An error ocurred: $error</B>");
    die("$error");
}

#########################################################################
sub internic_down  {
#########################################################################

    local($fqdn) = @_;
    local($TEXT_FONT) = $FONTS{"text"} ? $FONTS{"text"} : "Arial";
    local($TEXT_FONT_SIZE) = $FONTS{"size"} ? $FONTS{"size"} : "-1";

print <<EOM;
<BLOCKQUOTE>
<FONT FACE="$TEXT_FONT" SIZE=$TEXT_FONT_SIZE>
I have tried to look up the domain $fqdn several times, but
the InterNIC is reporting that its database is down. Please wait a few
seconds and click on the button below to retry your search,

EOM

	if($REFERER) {
	print <<EOM;
Or click <A HREF="$REFERER">here</A> to return to the whois Lookup.
EOM
	} else {
print <<EOM;
Or click on your Browser's "Back" button to choose another domain,
EOM
	}
print <<EOM;
<P>
<CENTER>
<FORM METHOD=POST ACTION="$SCRIPT">
<INPUT TYPE="hidden" NAME="domain" VALUE="$domain">
<INPUT TYPE="hidden" NAME="ext" VALUE="$ext">
<INPUT TYPE="hidden" NAME="fqdn" VALUE="$fqdn">
<INPUT TYPE="hidden" NAME="lookup" VALUE="OK">
<INPUT TYPE="hidden" NAME="root_allowed" VALUE="$root_allowed">
<INPUT TYPE="hidden" NAME="cdomain" VALUE="2.6">
<INPUT TYPE="submit" VALUE="Retry Lookup">
</FORM>
</CENTER>   
</FONT>
</BLOCKQUOTE>
<p>
<p>

EOM
}