#!/usr/local/bin/perl
# tbnet v1.6
# Builds indexes of a Gopher menu tree
# Copyright (C) 1993, Trustees of Michigan State University
# 
# Modifications:
# Original author unknown
# 07/07/92 Boone      Major conversion from gopherls to gophertree
# 08/14/92 Boone      Fixes: 
#                        added code to allow command line limit on recursion 
#                           depth
#                        quit indenting after 15 levels to avoid filling the
#                           title field with spaces
#                        changed to use IP address instead of hostname when
#                           checking for off-host links; this should make
#                           aliased machine names (e.g. gopher.someschool.edu)
#                           work much better
#                     Enhancements:
#                        Added option to list only directories
#                        Changed limit on number of items listed to apply to
#                           all types except directories, instead of just
#                           files; still no per-type limits though
#                        Changed command line processing to use Getopts, 
#                        allowing better option processing
# 02/15/93 Boone      Conversion to tbnet
# 03/23/93 Boone      Additional cleanup to remove unused code
# 04/01/93 Boone      Additional fixes to prevent wandering news servers
# 04/08/93 Boone      Added filter for ftp: paths--lets you decide whether
#                     you want to traverse those subtrees or not.
# End Modifications

require "getopts.pl";

sub dokill
{
    kill 9,$child if $child;
}

sub Opengopher
{
    local($them,$port) = @_;	
    $them = 'localhost' unless $them;

    $AF_INET = 2;
    $SOCK_STREAM = 1;

    $SIG{'INT'} = 'dokill';

    $sockaddr = 'S n a4 x8';

    chop($hostname = `hostname`);

    ($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($them);

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

    # Make the socket filehandle.
    socket(S, $AF_INET, $SOCK_STREAM, $proto) || die $!;

    # Give the socket an address.
    bind(S, $this) || die $!;

    # Call up the server.
    connect(S,$that) || die $!;

    # Set socket to be command buffered.
    select(S); $| = 1; select(STDOUT);

}

sub ftpok
{
	local($path) = @_;
	if ($path !~ /^ftp:/) { return 1; }
	if ($opt_f) { return 1; }
	return 0;
}

sub GetList 
{
	local($CurrentHost, $Port, $Path, $indent) = @_;
	local(@dirx, $Name, $Obj, $fname, $ftype, $fhost, %i, $truncated);
	&Opengopher($CurrentHost, $Port);
	print S "$Path\n";
	@dirx = <S>;
	close(S);
	$truncated = 0;
	foreach (@dirx) 
	{
		last if /^\./;
		chop; chop;
		($ObjName, $Path, $CurrentHost, $Port) = split('\t', $_);
		$Name = substr($ObjName, 1);
		$Obj = substr($ObjName, 0, 1);
		$fhost = $CurrentHost;
		if ($fhost eq "error.host")
		{
			print STDERR "Error: $Path resulted in $_\n";
			next;
		}

		$writeme = 1;
		if ((! $opt_d) && ($Obj ne "1") && ($i{$Obj} > $breaklong))
		{
			$writeme = 0;
			$truncated = 1;
		}
		if ($Obj eq "i")		{ $writeme = 0; }
		if ($opt_d && ($Obj ne "1"))	{ $writeme = 0; }
		if ($writeme)			{ print F $_, "\n"; }

		if ($hostable{$CurrentHost} eq "")
		{
			$hostable{$CurrentHost} =
				unpack("L", (gethostbyname($CurrentHost))[4]);
		}

		if (($Obj eq "1") && 
			($hostable{$CurrentHost} eq $hostable{$firsthost}) && 
			($Port eq $firstport) &&
			($Path ne "") &&
			(&ftpok($Path)))
		{
			$depth++;
			if ($depth <= $maxdepth)
			{
				&GetList($CurrentHost, $Port, 
					$Path, $newindent);
			}
			$depth--;
		}

		$i{$Obj}++;
	}
}

# **************************************************************************
# * Main
# **************************************************************************

# Parse command line

	&Getopts("b:l:dr:f");
	if ($#ARGV < 1) 
	{
		print "Usage: tbnet [-d -bn -ln -rn -f] host port path\n";
		exit(1);
	}

	$firsthost = $CurrentHost = $ARGV[0];
	$firstport = $Port = $ARGV[1];
	$Path = "";
	if ($#ARGV == 2) 
	{
		$Path = $ARGV[2];
	}

# Initialize some variables

	$depth = 1;         # How deep into the maze are we?
	$hostable{$firsthost} = unpack("L", (gethostbyname($firsthost))[4]);

# CHANGE--User-configurable defaults

	$breaklong = 99999; # CHANGE--Where to break long lists
	$maxdepth = 999;    # CHANGE--How deep to go before "pruning" layers

# Stuff command line changes into the config variables

	if ($opt_b) { $breaklong = $opt_b; }
	if ($opt_l) { $= = $opt_l; }
	if ($opt_r) { $maxdepth = $opt_r; }

# Open the output file

	open(F, ">.ts/.tsdata") || die "$0: unable to open .ts/.tsdata";

# Real work

	&GetList($CurrentHost, $Port, $Path, $indent);
	close(F);
	exit(0);

# End
