#!/usr/bin/perl
#
# query.pl
# Copyright (c) 1996 SurfUtah.Com
# written by Rus Berrett
#
# $Id: query.pl,v 4.51 1999/12/03 23:10:35 rus Exp $
#
# perform generic query on internic database 
# requires perl5 for "minimal matching" regular expression statements
# 

##############################################################################
# initialization and configuration

require "util.pl";

# check_referer("your-domain.name", "another-domain.name);

# where does everything live
$whois = "/usr/bin/whois";
$domaincodes = "domain-codes";

# check for existence of necessary files
unless (-e "$whois") {
  $errmsg = "Request failed due to improper script configuration.\n";
  $errmsg .= "Cannot find \"$whois\".  Please check your configuration\n";
  $errmsg .= "settings at the top of the $ENV{'SCRIPT_NAME'} file.\n<p>\n";
  return_error("Domain Name Lookup Error: whois not found", $errmsg);
}
unless (-e "$domaincodes") {
  $errmsg = "Request failed due to improper script configuration.  Cannot\n";
  $errmsg .= "find \"$domaincodes\".  Please check your configuration\n";
  $errmsg .= "settings at the top of the $ENV{'SCRIPT_NAME'} file.\n<p>\n";
  return_error("Domain Name Lookup Error: domain codes not found", $errmsg);
}

##############################################################################
# parse for input

# get the form data
parse_form_data(*array);

##############################################################################
# error checking
#
# required variables:  name
#

# check for name
if ($array{'name'} eq "") {
  $errmsg = "You failed to provide a value for the domain name.  Please \n";
  $errmsg .= "provide a value for the domain name and resubmit.\n<p>\n";
  return_error("Domain Name Lookup Error: Name Not Provided", $errmsg);
}

##############################################################################
# process the data

# check for valid characters in name
if ($array{'name'} =~ /[^a-zA-z0-9-.,!?^\@~*=\$\%\ ]/) {
  $array{'name'} =~ s/[^a-zA-z0-9-.,!?^\@~*=\$\%\ ]//g;
}

# check for valid characters in host
if ($array{'host'} =~ /[^a-zA-z0-9-.]/) {
  $array{'host'} =~ s/[^a-zA-z0-9-.]//g;
}

# figure out what whois server we need to use
if (($array{'host'} eq "") && 
    (($array{'name'} =~ /\.com$/) ||
     ($array{'name'} =~ /\.net$/) ||
     ($array{'name'} =~ /\.org$/))) {
  $command = "$whois -h whois.internic.net \"$array{'name'}\" 2>&1";
  open(SHELL, "$command |");
  while(<SHELL>) {
    s/^\s+//g;
    s/\s+$//g;
    s/\s+/ /g;
    if (/^Whois Server: (.*)/) {
      $array{'host'} = $1;
      last;
    }
  }
  close(SHELL);
}

if ($array{'host'} eq "") {
  $array{'host'} = "whois.networksolutions.com";
}

##############################################################################
# send a message back to the client

print_header_info("Whois Query: $array{'name'}");

# perform the whois query
print "<ul><pre>";
$command = "$whois -h $array{'host'} \"$array{'name'}\" 2>&1";
open(SHELL, "$command |");
while(<SHELL>) {
  $mul = "";
  # check for internic identifiers and mark with an "a"
  # this could get messy - especially my regular expressions (sorry)
  if (/Domain servers in listed order/) {
    $dnslist = 1;
  }
  if (/(.*?)\(([A-Z0-9\.\-]*)\)(.*)/) {
    $before = $1; $identifier = $2; $after = $3;
    $textcheck = $2;
    $textcheck =~ tr/A-Z/a-z/;
    if ((length($textcheck) != 1) && 
        ($textcheck !~ /^[0-9]/) &&
        ($textcheck ne "fax")) {
      $mul = &string_mdn($before) . "("; 
      $mul .= "<a href=\"$ENV{'SCRIPT_NAME'}?";
      $mul .= "host=$array{'host'}&name=$identifier\">";
      $mul .= "$identifier</a>)";
      $mul .= &string_mdn($after);
    }
    else {
      $mul = &string_mdn($_);
    }
  }
  else {
    $mul = &string_mdn($_);
  }
  print $mul;
  print "\n" if ($mul !~ /\n$/);
}
close(SHELL);
print "</pre></ul>\n\n";

print "<p>\n";

print_footer_info();

##############################################################################
##############################################################################

##############################################################################
# markup domain names in current string
sub string_mdn
{
  local($mystring) = @_;
  local($newstring);
  local($pre, $char, $first, $second, $third, $forth, $fifth, $post);
  local($iwhois_cgi);

  $iwhois_cgi = $ENV{'SCRIPT_NAME'};
  $iwhois_cgi =~ s/whois\/query.pl/iwhois\/lookup.pl/;

  if ($mystring =~ /(.*?)([\@\t\ ])([A-Z0-9\-]*)\.([A-Z0-9\-]*)\.([A-Z0-9\-]*)\.([A-Z0-9\-]*)\.([A-Z0-9\-]*)(.*)/) {
    $pre = $1; $char = $2;
    $first = $3; $second = $4; $third = $5; $fourth = $6; $fifth = $7;
    $post = $8;
    if (($first ne "") && ($second ne "") && ($third ne "") && 
        ($fourth ne "") && ($fifth ne "") && ($dnslist || &vtld($fifth)) &&
        (($first !~ /[0-9\-\.]/) ||
         ($second !~ /[0-9\-\.]/) ||
         ($third !~ /[0-9\-\.]/) ||
         ($fourth !~ /[0-9\-\.]/))) {
      $newstring = &string_mdn($pre);
      if ($dnslist || &itld($fifth)) {
        $newstring .= "$char\<a href=\"$ENV{'SCRIPT_NAME'}?";
      }
      else {
        $newstring .= "$char\<a href=\"$iwhois_cgi?";
      }
      $newstring .= "host=$array{'host'}&";
      $newstring .= "name=$first\.$second\.$third\.$fourth\.$fifth\">";
      $newstring .= "$first\.$second\.$third\.$fourth\.$fifth</a>";
      $newstring .= &string_mdn($post);
    }
  }
  elsif ($mystring =~ /(.*?)([\@\t\ ])([A-Z0-9\-]*)\.([A-Z0-9\-]*)\.([A-Z0-9\-]*)\.([A-Z0-9\-]*)(.*)/) {
    $pre = $1; $char = $2;
    $first = $3; $second = $4; $third = $5; $fourth = $6;
    $post = $7;
    if (($first ne "") && ($second ne "") && ($third ne "") && 
        ($fourth ne "") && ($dnslist || &vtld($fourth)) &&
        (($first !~ /[0-9\-\.]/) ||
         ($second !~ /[0-9\-\.]/) ||
         ($third !~ /[0-9\-\.]/) ||
         ($fourth !~ /[0-9\-\.]/))) {
      $newstring = &string_mdn($pre);
      if ($dnslist || &itld($fourth)) {
        $newstring .= "$char\<a href=\"$ENV{'SCRIPT_NAME'}?";
      }
      else {
        $newstring .= "$char\<a href=\"$iwhois_cgi?";
      }
      $newstring .= "host=$array{'host'}&";
      $newstring .= "name=$first\.$second\.$third\.$fourth\">";
      $newstring .= "$first\.$second\.$third\.$fourth</a>";
      $newstring .= &string_mdn($post);
    }
  }
  elsif ($mystring =~ /(.*?)([\@\t\ ])([A-Z0-9\-]*)\.([A-Z0-9\-]*)\.([A-Z0-9\-]*)(.*)/) {
    $pre = $1; $char = $2;
    $first = $3; $second = $4; $third = $5; 
    $post = $6;
    if (($first ne "") && ($second ne "") && ($third ne "") &&
        ($dnslist || &vtld($third)) &&
        (($first !~ /[0-9\-\.]/) ||
         ($second !~ /[0-9\-\.]/) ||
         ($third !~ /[0-9\-\.]/))) {
      $newstring = &string_mdn($pre);
      if ($dnslist || &itld($third)) {
        $newstring .= "$char\<a href=\"$ENV{'SCRIPT_NAME'}?";
      }
      else {
        $newstring .= "$char\<a href=\"$iwhois_cgi?";
      }
      $newstring .= "host=$array{'host'}&";
      $newstring .= "name=$first\.$second\.$third\">";
      $newstring .= "$first\.$second\.$third</a>";
      $newstring .= &string_mdn($post);
    }
  }
  elsif ($mystring =~ /(.*?)([\@\t\ ])([A-Z0-9\-]*)\.([A-Z0-9\-]*)(.*)/) {
    $pre = $1; $char = $2;
    $first = $3; $second = $4;
    $post = $5;
    if (($first ne "") && ($second ne "") &&
        ($dnslist || &vtld($second)) &&
        (($first !~ /[0-9\-\.]/) ||
         ($second !~ /[0-9\-\.]/))) {
      $newstring = &string_mdn($pre);
      if ($dnslist || &itld($second)) {
        $newstring .= "$char\<a href=\"$ENV{'SCRIPT_NAME'}?";
      }
      else {
        $newstring .= "$char\<a href=\"$iwhois_cgi?";
      }
      $newstring .= "host=$array{'host'}&";
      $newstring .= "name=$first\.$second\">";
      $newstring .= "$first\.$second</a>";
      $newstring .= &string_mdn($post);
    }
  }
  $newstring = $mystring if ($newstring eq "");
  $newstring;
}

##############################################################################
# check for valid tld
sub vtld
{
  local($mytld) = @_;

  $mytld =~ tr/A-Z/a-z/;

  $ftld = "";
  open(DCF, "$domaincodes");
  while (<DCF>) {
    tr/A-Z/a-z/;
    $pin = index($_, "\ ");
    $ftld = substr($_, 0, $pin);
    if ($ftld eq $mytld) {
      last;
    }
    $ftld = "";
  }
  close(DCF);
  return (0) if ($ftld eq "");

  return(((-e "../iwhois/lookup.pl") ||
          (($mytld eq "arpa") ||  
           ($mytld eq "com") ||
           ($mytld eq "edu") ||
           ($mytld eq "gov") ||
           ($mytld eq "net") ||
           ($mytld eq "org"))) ? 1 : 0);
}

##############################################################################
# check for valid internic tld
sub itld
{
  local($mytld) = @_;

  $mytld =~ tr/A-Z/a-z/;
  return((($mytld eq "arpa") ||  
          ($mytld eq "com") ||
          ($mytld eq "edu") ||
          ($mytld eq "gov") ||
          ($mytld eq "net") ||
          ($mytld eq "org")) ? 1 : 0);
}

##############################################################################
# eof query.pl

