#!/opt/perl/bin/perl -w
#
# This code copyright 1999 by
# W.M. Richards, NiEstu, Phoenix, AZ -- chipr@niestu.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact chipr@niestu.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at chipr@niestu.com.
#
# Bring in some useful library scripts
use FileHandle;
use Socket;

#
# Constants
$command  = 'HEAD /';
$protocol = 'HTTP/1.0';
$progname = 'WhoRU 0.1 (unix)';

$true  = 1;
$sockaddr = 'S n a4 x8';

$err_not_given = '(not given)';
$err_no_conn   = "(can't connect)";

@prefixes = ( '', 'www.', 'www.', 'www.', 'www.', 'www.' );
@suffixes = ( '', '',     '.com', '.org', '.edu', '.net' );

#
# Useful things for this script to know
chomp ($hostname = `hostname`);
$hostname = 'localhost' unless $hostname;

#
# Check if we have any args
if (! defined (@ARGV) || scalar (@ARGV) <= 0)
{
   die "\n\nSyntax:\n\n   $0  web-server-hostname[:port]  ...\n\n";
}

#
# Check the identity for given hosts
foreach $server_host (@ARGV)
{
   &query_server_type ($server_host);
}

exit (0);




#
# Connect to the web server and return the file handle
sub open_web_server
{
   my ($server, $port) = @_;
   my ($junk, $proto, $locaddr, $rmtaddr, $us, $them, $handle);

   return undef unless $server && $port;  # fail if we don't know where to send it
   ($junk, $junk, $proto) = getprotobyname ('tcp');
   ($junk, $junk, $junk, $junk, $locaddr) = gethostbyname ($hostname);
   ($junk, $junk, $junk, $junk, $rmtaddr) = gethostbyname ($server);

   return undef unless (defined ($locaddr) && defined ($rmtaddr));
   $us   = pack ($sockaddr, AF_INET, 0, $locaddr);
   $them = pack ($sockaddr, AF_INET, $port, $rmtaddr);

   $handle = "${server}:${port}";
   return undef unless (socket ($handle, PF_INET, SOCK_STREAM, $proto));
   return undef unless (bind ($handle, $us));
   return undef unless (connect ($handle, $them));
   $handle -> autoflush ($true);
   return $handle;
}


#
# Get the server type from a remote web server
sub query_server_type
{
   my ($host_spec) = shift;
   my ($name, $index, $host, $port, $socket, $line, $server_type);

#
# Remove leading protocol if present
   $host_spec =~ s#^\s*http:/+##i;

#
# See if an alternate port was given as "host:port"
   if ($host_spec =~ /:/)
   {
      ($name, $port) = split (/:/, $host_spec);
   }
   else
   {
      $name = $host_spec;
      $port = 80;  # default HTTP port
   }

#
# Open the server if we can
   for ($index = 0;   $index < scalar (@prefixes);   ++$index)
   {
      $host = $prefixes [$index] . $name . $suffixes [$index];
      $socket = &open_web_server ($host, $port);
      last if ($socket);
   }
   if ($socket)
   {
      $server_type = $err_not_given;  # unless reset by a "Server:" line from remote
      print $socket  "$command $protocol $progname\r\n\r\n";
      while (defined ($line = <$socket>))
      {
         chomp ($line);
         if ($line =~ /^\s*server:\s*(.*)$/i)
         {
            $server_type = $1;
         }
      }
   }
   else
   {
      $server_type = $err_no_conn;
   }
   print "$host($port):  $server_type\n";
}
