#/usr/local/bin/perl
# gopherhunt - hunt for dead gophers (i.e. dead gopher links...)
#
# Bring out your dead!

# usage:
# gopherhunt host port [path]
# gopherhunt gopher.micro.umn.edu 70 "1/FTP Searches"

# original NNTP client suggested by eci386!clewis
# socket code mailed to me by cmf@obie.cis.pitt.edu (Carl M. Fongheiser)
# adaptation for gopher by emv@msen.com (Edward Vielmetti)
# modification to indexer by alberti@boombox.micro.umn.edu (Bob Alberti)
# mods for gopherhunt by Paul Lindner
#

$service = "gopher";
$host = shift || "gopher.micro.umn.edu";
$port = shift || 70;
$path = shift || "";

#If debug = 0, gopherclone runs silent.  =1 is a verbose run.  Commented
#debug lines are annoyingly thorough

$DEBUG = 0;              #set this to 0 for silent operation

if ($host && $port) {
                         $DEBUG && print "host=$host; port=$port; path=$path\n";

   require 'socket.ph';  # h2ph socket.h, copy socket.h from sys file
                         # and put socket.ph in the current directory
   chop($hostname = `hostname`);        # get host name in variable

   ($N) = &tcpconnect($host, $hostname);# open connection 

   &gopherlevel($host, $hostname, $path, N); # clone the gopher

   close(N);                            # close the connection.  NOTHING TO IT!

   # Now test all the links

   foreach $i (keys(%TestedHosts)) {
	($host, $port) = split(' ', $i);

	if (! &isalive($host, $port)) {
		print "$host, port $port is down\n";
        }

   }

}

else {
   print "Command format:\n\n";
   print "   $0 <hostname> <port> [<path>]\n\n";
   print "Example:\n";
   print "   $0 gopher.micro.umn.edu 70 \"1/FTP Searches\"\n";

}

sub gopherlevel {          # Build a level of gopher directory before recursion
   local($host, $hostname, $path, $N) = @_;
                           $DEBUG && print "sending path=$path\n";
   send(N,"$path\r\n",0);
                           #$DEBUG && print STDERR "$path\r\n";
   local($dirnum, $docnum, $i, @doc, @dir); #avoid scoping errors
   @doc = 0;               #call me a fuddy-duddy but I like to Know
   @dir = 0;

   while(<N>)  {                 #While receiving data
      chop;chop;                 # trim data
      next if /^[\. ]*$/;        # quit if a period
      s/^(.)// && ( $type = $1); # otherwise Type is first character
      @G= split(/\t/);           # and split other fields on tabs

                                 #$DEBUG &&  print "Type=$type\n";
                                 #$DEBUG &&  print "Name=$G[0]\n";
                                 #$DEBUG &&  print "Path=$G[1]\n";
                                 #$DEBUG &&  print "Host=$G[2]\n";
                                 #$DEBUG &&  print "Port=$G[3]\n";

      if (($host ne $G[2])) {  # Aha a link!
		# Only test out directory links for now
                if (($type eq "1")||($type eq "7")) {
			$DEBUG && print "Found a link: $G[0]\n";
			$key = $G[2] . " ". $G[3];
			if ($TestedHosts{$key} ne "true") {
				$TestedHosts{$key} = "true";
			}

		}

	        next;

      }

      if ($type == 1)  {         # Add directories to the list of directories
         $dirnum += 1;
         $dir[$dirnum] = $G[1];  # to be built after all information received
                      $DEBUG && print "$dirnum: $dir[$dirnum]\n";   
      }

   }
   close(N);

                                 #$DEBUG && print "\n";

   for ($i = 1; $i <= $dirnum; $i++) {     # Make directories
      @path = split('/',$dir[$i]);         # split off leading entries in path;
      $dirname = $path[$#path];            # take last item as name
                              $DEBUG && print "dirname: $dirname\n";
      $_ = $dirname;                       #Bah, this is ungraceful, but 
      if (/^\S/) {                         #sometimes $dirname is blank.
	 ; #print "Moo" . $dirname . "\n";
      }
      else {
           next;
      }

      ($N) = &tcpconnect($host, $hostname);
	
      if ($N) {
         &gopherlevel($host, $hostname, $dir[$i], N);
         sleep(2);     #arbitrary sleeps give sockets time to close
      }
      else {
         die "Couldn't open tcp connection $N: $!\n"; 
      }
      close(N);
   }  
}


sub tcpconnect {                    #Get TCP info in place
   local($host, $hostname) = @_;
   $sockaddr = 'S n a4 x8';

                            #$DEBUG && print "host: $host, me: $hostname\n";

   ($name,$aliases,$proto) = getprotobyname('tcp');
   ($name,$aliases,$port) = getservbyname($port, 'tcp')
        unless $port =~ /^\d+$/;
   ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
   ($name,$aliases,$type,$len,$thataddr) = gethostbyname($host);

   $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
   $that = pack($sockaddr, &AF_INET, $port, $thataddr);

   sleep(2);

   socket(N, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";	
   bind(N, $this)                            || die "bind: $!";
   connect(N, $that)                         || die "connect: $!";

   return(N);
}


#
# This tests to see if a socket is answering connections..
#

sub isalive {                    #Get TCP info in place
   local($host, $port) = @_;
   $sockaddr = 'S n a4 x8';

   ($name,$aliases,$proto) = getprotobyname('tcp');
   ($name,$aliases,$port) = getservbyname($port, 'tcp')
        unless $port =~ /^\d+$/;
   ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
   ($name,$aliases,$type,$len,$thataddr) = gethostbyname($host);

   $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
   $that = pack($sockaddr, &AF_INET, $port, $thataddr);

   sleep(2);

   socket(N, &PF_INET, &SOCK_STREAM, $proto) || return(0);	
   bind(N, $this)                            || return(0);
   connect(N, $that)                         || return(0);

   sleep(1);
   print N "\r\n" || return(0);
   sleep(1);
   
#   while (<N>) {  # Siphon off the data...
#	print;
#   }

   close(N);

   return(1);
}