Replied:      Mon, 20 Sep 1993 17:12:15 -0500 Bob Kaehms <kaehms@sedbsvr.se.ssd.lmsc.lockheed.com>
Date:         Mon, 20 Sep 1993 14:39:18 PDT
From:         Bob Kaehms <kaehms@sedbsvr.se.ssd.lmsc.lockheed.com>
To:           sanders@BSDI.COM
Subject:      Re: pearly gopher unix security question... 

> This will also solve the problem..
>     $SIG{'CHLD'} = 'IGNORE';
Would have tried that but at the top of the note from Steven Lidie he said he tried it but still had a bunch of zombies lying around... I was new, and just
wanted to get something working....it does...no zombies, and I will probably
tend towards your route when I clean things up....

The following is the code...there is a big hack in it when it creates directory
listings.  I had it almost cleaned up last week, but it was returning . files
in the results and something was burping when it tried to process link files.
.....so I went back to the hack wher I copy the request into @tmp.

If you use any of it, just put a "thanks" into the code with a ref to me at
my well address.  Also thank Jonny Goldman...

(don't mention Lockheed)


-bob

#!/usr/local/bin/perl
# sGs.pl (simple Gopher server)
############################################################################

$revision="0.0 beta "; #Aug 23 1993 original
$maintainer_person="Bob Kaehms or Jay Schaefer";
$maintainer_phone="(408)756-6955 (X6955)";
$maintainer_address="sys_engr@sedbsvr.se.ssd.lmsc.lockheed.com";
&register();
#############################################################################
#                            DESCRIPTION
#
#  A simple gopher server which handles type 0,1, g, and 7 gopher requests.
#
#############################################################################
#                            CHANGES
# -------  B.Kaehms    Decided J Goldman's waismail.pl should do gopher
# 9/14/93  B.Kaehms    made $wais_bin a configurable (tacked on to -w option)
# 9/14/93  B.Kaehms    added type 4 (.hqx) and type 9 (bin) to vaild types
# 9/14/93  B.Kaehms    fixed $thishost for problems with . when domainname 
#                      not set.
# 9/14/93  B.Kaehms    $maxres set to 200 for wais searches to help avoid
#                      assumptions that a user may have found everything.
#                      (9/16/93....still a bug here something sets it to 40)
# 9/16/93  B.Kaehms    Fixed a few last minute bugs associated with parens 
#                      prior to releasing on augusta
#
#############################################################################
fork && exit;      #run as a deamon
setpgrp(0,$$);
############################## MAIN #########################################

# want to put a $SIG('INT') = 'cleanup' 
# where cleanup is sub cleanup( #shut things down nicely)

&init_gopher();

&init_socket();

&trap_gophers();

#############################  END ########################################## 
sub init_gopher {

$host=`hostname`;chop($host);$domain=`domainname`;chop($domain);
if ($domain) { 
  $thishost="$host.$domain";
} 
else {
 $thishost=$host
}
$port="1470";$thisport=$port;$gd="/users/gopher/gopher-data";
$wais_op="0";$menutype="d";$cachefile=".cache";
#$wais_bin="/users/wais/w8b5bio/bin";  # should be a configurable sometime
# $wais_bin now a command line option -w /users/wais/w8b5bio/bin
$maxres = 200;
$tmpfile = "/tmp/sGs.$$";
$outfile = "/tmp/sGs.out.$$";
$errfile = "/tmp/sGs.err.$$";
$errorlog = "./sGs.err";
$sfile   = "sGs.$$.src";
$logfile = "./sGs.log";

while (@ARGV) {
  $_=shift @ARGV;
  if (/^-c|^-C|^-l|^-h|^-p|^-d|^-m|^-u|^-v|^-w|^-H/) { #good arguments

  if (/-c/) {
   $c_file=shift @ARGV;
   if ( -T "$c_file" ) { &process_config_file(); }
    else { die "-c: improper filename $c_file\n";}
  }

  if (/^-l/) { $logfile=shift @ARGV;}
  if (/^-p/) { $port=shift  @ARGV;$thisport=$port;}   
  if (/^-d/) {$gd=shift  @ARGV;
  if (! -d "$gd"){die "Not a valid directory: $gd\n";}}    

  if (/^-m/) {       # menu type (d)ynamic (default)  or (s)tatic
    $menu_op=shift @ARGV; 
    $menutype="";
    $menutype="s" if ($menu_op eq "s");
    $menutype="d" if ($menu_op eq "d");
    die "-m: bad option $menu_op  (use d or s) \n" if ($menutype eq "");
  }
  if (/^-C/) { $cachefile=shift @ARGV;}

  if (/^-u/) {       # setuid to user  (default whoever starts it)  
    print "-u option not implemented yet\n";
  }

  if (/^-v/) {&print_version(); die "\n";}
  if (/^-w/) { 
    $wais_op="1";
    $wais_bin= shift @ARGV;
    if (! -d "$wais_bin") {die "$wais_bin... not a valid directory\n"}
    $ENV{'PATH'} = $ENV{'PATH'}.":$wais_bin";
  } 

  if (/^-H/) {
    $host=shift @ARGV;$thishost=$host;
  }

  if (/^-h|^-\?|^\?/) { &print_help(); die "\n";} 
  } else {&print_help(); die "\n";} # bad arguments
} #while ARGV

if ($logfile){  #we do this once to make sure we can.
open (LOG,">>$logfile") || die "can't open logfile: $logfile: $!\n";
close (LOG);
}
open(ELOG,">>$errorlog") || die "can't open error log\n";
close (ELOG);  #just checking...

$with_options="-h $thishost -p $port -d $gd -m $menutype -w $wais_op ";
$start_mess="$timestamp Starting sGs: $with_options";
&print_version(); sleep 2;
print "\n";
print "$start_mess\n";
sleep 4;system("clear");print "Welcome to sGs....\n";
&log_request("sGs Started $with_options\n");
}

#############################################################################
#
sub process_config_file {
#
# a config file is just a bunch of command line options put into a file
# one line at a time.
# Example:
#   -d /users/gopher/gopher-data
#   -p 1500
#   -w /users/wais/w8b5bio/bin
#   -l /your/gopher/log


 open (CONFIG, "<$c_file") || die "cant open $c_file";
 while (<CONFIG>) {
 @op= split(/\s/, $_);
  $_=shift(@op);
  if (/^-H/) { $host=shift(@op); $thishost=$host;}      
  if (/^-l/) { $logfile=shift(@op); }
  if (/^-p/) { $port=shift(@op);$thisport=$port }      # port 
  if (/^-d/) {       # gopher directory 
    $gd=shift(@op);  
    if (! -d "$gd" ) {
      die "Not a valid directory: $gd\n";
    } 
  }
  if (/^-m/) {       # menu type (d)ynamic (default)  or (s)tatic
    $menutype="";
    $menu_op=shift(@op);
    $menutype="s" if ($menu_op eq "s");
    $menutype="d" if ($menu_op eq "d");
    die "-m: bad option $menu_op   (use d or s) \n" if ($menutype eq "");
  }
  if (/^-C/) { $cachefile=shift(@op); } # default is .cache
  if (/^-u/) {       # setuid to user  (default whoever starts it)  
    print "-u option\n";
  }
  if (/^-w/) {          # WAIS SEARCH OPTION default nowais
    $wais_op="1";
    $wais_bin=shift(@op);
    if (! -d "$wais_bin") {die "$wais_bin... not a valid directory\n"}
    $ENV{'PATH'} = $ENV{'PATH'}.":$wais_bin";
 } 
}
}
###############################################################################
#

sub print_version{

system("clear");
print "\n\n";
#should use printf below for cleaner output, or template stuff....
print "
 ##############################################################################
 #                                                                            #
 #                       Lockheed SSD Systems Engineering                     #
 #                                                                            #
 #                                     sGs                                    #
 #                                                                            #
 #                                    Gopher                                  #
 #                               simple   server                              #
 #                                                                            #
 #                              Version: $revision                            #
 #                                                                            #
 ################################# For Support ################################
 #                                                                            #
 #   contact: $maintainer_person     phone: $maintainer_phone     #
 #    e-mail: $maintainer_address                       #
 #                                                                            #
 ##############################################################################\n";
}


#############################################################################
sub print_help {

print "
sGs [-c <configfile>] [-p <port>] [-d <gopher-data-dir>] [-l <logfile>]
    [-m <s || d>] (static or dynamic {default} menus)  [-u <user>]
    [-h|-H|-?|?] (prints this file)  [-v] (prints version)  [-w] (allow WAIS)
    [-C <cachefile>] (when running with static menus.  Default .cache)
    \n";
} 
#############################################################################
sub init_socket{

$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';

($name, $aliases, $proto) = getprotobyname('tcp');
if ($port !~ /^\d+$/) {
  ($name, $aliases, $proto) = getservbyport($port, 'tcp');
}
$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");

select(NS); $| = 1; select(stdout);

socket(S,$AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
bind(S,$this) || die "bind: $!";
listen(S,5) || die "connect:$!";

select(S); $| = 1; select(stdout);
$WNOHANG =1;
}
#######################################################################
sub trap_gophers{

for($con = 1; ; $con++) {
   ($addr = accept(NS,S)) || die $!;
FORK:
   if (($pid = fork()) != 0) { # parent
    close(NS);
    while (1) { last if (waitpid(-1,$WNOHANG) < 1);}
   } elsif (defined $pid) { # child

     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
     @inetaddr = unpack('C4',$inetaddr);
     while (<NS>) {
       if (! &valid_request($_)) {close(NS);exit(-1);}
       if (/^\r/) {&log_request("CONNECT\n");&senddir();}
       if (/^1/) {&senddir();}
       if (/^0/) {&sendfile();}
       if (/^4/) {&sendfile();}
       if (/^9/) {&sendfile();}
       if (/^g/) {&sendfile();}
       if (/^7/) {&wa2go();} 
       close(NS); 
       exit(0);
     }
    } elsif ($! =~ /No more process/) { #EAGAIN is recoverable
      sleep 2;
      redo FORK;
    } else {                        # wierd fork error
      die " could not fork child to handle connection!!!: $!\n";
    }
   }  
   close(NS);
}
######################################################################
sub sendfile{
    $gopher_wd=$gd;  #??????
    $request=$_;
    &log_request(":FILE:$request");
    substr($request,0,2) = "";  #??? cleaning out delimeters, or what?
    @tmp=split(" ",$request);
    $rd=@tmp[0];
    for ($i=1;$i<=$#tmp;$i++){
    $rd="$rd" . "\\";
    $rd = $rd . " @tmp[$i]";}

  open(REPLY, "<$gd/$request");
  while (<REPLY>){send(NS,"$_",0);}
}
######################################################################
sub senddir{   #NEED TO PUT IN A FLAG FOR STATIC/DYNAMIC
  $gopher_wd=$gd;
  $request=$_; 
  &log_request(":DIR:$request");
  substr($request,0,1) = "";
  @tmp=split(" ",$request);
  if ("@tmp" =~/^\./) {return;}
  if ("@tmp" =~/\.\./) {return;}
  $rd=@tmp[0];
  for ($i=1;$i<=$#tmp;$i++){
 # $rd="$rd" . "\\";
  $rd = $rd . " @tmp[$i]";}
  chop @request[1]; 
if ($menutype eq "d") {
  open(REPLY, "ls -a1 '$gd/$rd' |");
  while (<REPLY>){
  $type="";
  @f= $_;chop(@f); chop $_; 
  if (/^\./) { &process_link($_);}
  else {
   #if ! ("@f" =~/^\./) {
   $type="0" if -T "$gopher_wd/@tmp/@f";
   $type="9" if -B "$gopher_wd/@tmp/@f"; #binary... will this get .tar stuff
   $type="1" if -d "$gopher_wd/@tmp/@f";
   $type="7" if  "$gopher_wd/@tmp/@f" =~/\.src/;
   $type="g" if  "$gopher_wd/@tmp/@f" =~/\.gif/;
   $type="4" if "$gopher_wd/@tmp/@f" =~/\.hqx/;
   #}
  
if ($type == 0 || $type == 1 || $type eq "g" || $type eq "9" || $type eq "4") {
 send(NS,"$type@f\t$type@tmp/@f\t$thishost\t$thisport\r\n",0);
}
$waissourcedir = ""; $ENV{'WAISCOMMONSOURCEDIR'} = $waissourcedir;

if ($type == 7 && $wais_op) {
$waissourcedir = "$gd/@tmp"; #chop $waissourcedir;
$ENV{'WAISCOMMONSOURCEDIR'} = $waissourcedir;
 send(NS,"$type@f\t$type::search::$waissourcedir::@f::\t$thishost\t$thisport\r\n",0);
 }
}
} 
  send(NS,".\r\n",0); 
} else { #menutype is static 
   chop($request); chop($request);
   open (CACHE, "< $gd/$request/$cachefile") || print "error opening $cachefile $!\n";
   while (<CACHE>){send(NS,"$_",0); }
}
}
############################################################################
sub wa2go{ #Modified from Jonny Goldman's waismail.pl <jonathan@think.com>

   $goph_string=$_;
   ($gophertype, $action, $wais_src_dir, $source, @words) = split(/::/,$_);
   if (/^maxres (\d+)/) { $maxres = $1;}

   if (/^7::search|^7::Search|^7::SEARCH/) {
   ($gophertype, $action, $wais_src_dir, $source, @words) = split(/::/,$_);
    $search=1;
    @sources=split(".src",$source);
    $ENV{'WAISCOMMONSOURCEDIR'} = $wais_src_dir;
    $maxres = 200;
    $waissourcedir=$wais_src_dir;
    &dosearch();
    }

   if (/^7::retrieve|^7::Retrieve|^7::RETRIEVE|^[ \t]{0,}DocID: /) {
    ($gophertype, $action, $docid) = split(/::/,$_);
    $retrieve = 1; $indocid = 1; chop($docid); chop($docid);
    &log_request(":RETRIEVING: $docid\n");
   }


if ($indocid == 1) {
   $indocid = 0;
   &doretrieve();
}

open(RESPONSE,"<$outfile");
while (<RESPONSE>){
if ($retrieve) {
send(NS,"$_",0);
}

if ($search){
  $/ = ""; #paragraph mode
  ($result,$heading,$DOCID) = split(/\n/,$_);
   if ($heading =~/Headline/){
   
   if ($DOCID =~/GIF/) {
   send(NS,"g$heading\t7::retrieve::$DOCID\t$thishost\t$thisport\r\n",0);
   }
   else {
   send(NS,"0$heading\t7::retrieve::$DOCID\t$thishost\t$thisport\r\n",0);
   }
   }
}
} 
 send(NS,".\r\n",0);

unlink $outfile;
unlink $tmpfile;
unlink $errfile;
unlink $sfile;
}
###############################################################################
sub dosearch {
 foreach $source (@sources) {
  if(!(-f "$waissourcedir/$source.src")) {
   &logerror("could not find source: $waissourcedir/$source.src");
  }
 } 
 
 open(TMP, ">$tmpfile");
 printf TMP "(:question :version  2\n :seed-words \"";
 foreach $w (@words) { printf TMP "$w ";};
 printf TMP "\"\n :relevant-documents\n ( ";
 
 if ($relevant) {
  
  foreach $rel (@reldocs) {
    $_ = $rel;
    /@/ &&  ($_ = $`) && (/:/) && ($id = $`) && ($db = $');
    printf TMP "\n  (:document-id \n   :document \n   (:document \n    :doc-id \n";
    printf TMP "     (:doc-id \n      :original-database %s \n      :original-local-id %s\n)\n"; 
    &stringtoany($db), &stringtoany($id);
    printf TMP "    :source (:source-id :filename \"$source.src\" )\n";
    printf TMP "    ) )\n";
 } 
 }

 printf TMP " )\n";
 printf TMP " :sourcepath \"$waissourcedir/:\" \n";
 printf TMP " :sources (\n";
 
 foreach $source (@sources) {
  printf TMP "  (:source-id :filename \"$source.src\" )\n";
 }

 printf TMP " )\n";
 printf TMP " :maximum-results %d )\n", $maxres;
 close(TMP);
 &log_request(":WAISSEARCH: @sources, words: @words");
 
 if ($relevant) {
  foreach $rel (@reldocs) {
   $_ = $rel;
   { &log_request("RelDocID: \"$rel\" ");}
  }
 }
 open (OUT, ">>$outfile");
 printf OUT "Searching: ";
 foreach $source (@sources) {
  printf OUT "$source ";
 }

 printf OUT "\nKeywords: ";
 foreach $w (@words) { printf OUT "$w "; };
 if ($relevant) {
  foreach $rel (@reldocs) {
   $_ = $rel;
   { printf OUT "\nRelDocID: \"$rel\"";}
  }
 }
 printf OUT "\n";
 system("waisq -f $tmpfile -g >> /dev/null 2> $errfile");
 open(ERR, "$errfile");
 
 while (<ERR>) { 
  if (/Connect to socket did not work:/) {
   &log_request("Error Searching @sources for @inetaddr: Bad connect (source down?)");
   &log_request("Error: $_");
   printf OUT "\n**** Error Searching @sources: not responding ****\n";
   printf OUT "\tPlease send mail to the maintainer.\n";
  }
 }
 close(ERR);
 #unlink($errfile);
 open(TMP, "$tmpfile");
 $inres = 0;

 while(<TMP>) {
   /:result-doc/ && ($inres = 1);
 
    if ($inres == 1) { 

       /:score\s+(\d+)/ && ($score = $1);
       ((/:headline "(.*)"$/ && ($headline = $1)) ||
        (/:headline "(.*)$/ && ($headline = $1)));
       /:number-of-bytes\s+(\d+)/ && ($bytes = $1);
       /:type "(.*)"/ && ($type = $1);
       /:filename "(.*)"/ && ($sourcename = $1);
       /:original-database / && ($database = $');
       /:original-local-id / && ($docid = $');
       /:date "(\d+)"/ && ($date = $1, &docdone);
      } 
 } 
 printf OUT "\n______________________________________________________________________\n\n";
 close(TMP);
 close(OUT);
 $relevant = ''; @reldocs = '';
 unlink($tmpfile);
 }
##############################################################################
sub doretrieve {
 $port = "0";
 $_ = $docid;
 s/^DocID: //g;
 if (/%/) {
  $docid = $`;
  $type = $'; 
  #print "in doretrieve type = :$type:...\n";
 }
 $_ = $docid;
 /:/ && ($id = $`) && ($db = $');
 /@/ &&  ($_ = $`) && (/:/) && ($id = $`) && ($db = $');
 $_ = $docid;
 /@/ &&  ($_ = $') && (/:/) && ($host = $`) && ($port = $');
 open(SRC, ">/tmp/$sfile");
 printf SRC "(:source :version 3 \n";
 printf SRC " :database-name \"$db\" :ip-name \"$host\" :tcp-port $port)\n";
 close(SRC);
 open(TMP, ">$tmpfile");
 printf TMP "(:question :version 2 :result-documents \n";
 printf TMP "  ( (:document-id :document (:document :doc-id\n";
 printf TMP "    (:doc-id :original-database %s\n", &stringtoany($db);
 printf TMP "     :original-local-id %s )\n", &stringtoany($id);
 printf TMP "     :number-of-bytes -1 :type \"$type\"\n";
 printf TMP "     :source (:source-id :filename \"$sfile\") ) ) ) )\n";
 close(TMP);
 $timestamp = &date() . " " . &time() . ":";
 &log_request(":WAISSEND:i\"$docid%%$type\" to @inetaddr");
 open(OUT, ">>$outfile");
 printf OUT "______________________________________________________________________\n" if ! ($type=~/GIF/);
 close(OUT);
 $docid = $docid."%".$type;
 if ($type eq "" || $type eq "TEXT" || $type eq " TEXT" ||$type eq "WSRC" ||$type eq "GIF") {
  $exres = system("waisq -s /tmp/ -f $tmpfile -v 1 >> $outfile 2> $errfile");
 }
 else {
  $exres = system("(waisq -s /tmp/ -f $tmpfile -v 1 | uuencode WAIS.res >> $outfile) 2> $errfile");
 }  
 unlink("/tmp/$sfile");
 open(OUT, ">>$outfile");
 open(ERR, "$errfile");
 while (<ERR>) { 
  if (/Missing DocID in request|Could not find Source/) {
   s/done//g;
   printf OUT "Error getting document:\n $_\n";
   printf OUT "(This is usually a bad DocID,\n or the server has deleted the document since you ran the search)\n";
   $timestamp = &date() . " " . &time() . ":";
   &log_request("Error Sending \"%s\" to @inetaddr: Bad DocID,\n $docid");
  }
 }
 close(ERR);
 #unlink($errfile);
 printf OUT "______________________________________________________________________\n" if ! ($type=~/GIF/);
 close(OUT);
}
############################################################################
sub docdone {
 open(SRC, "$waissourcedir/$sourcename");
 while(<SRC>) {
	/:ip-name[ \t]{0,}"(.*)"/ && ($ipname = $1);
	/:database-name[ \t]{0,}"(.*)"/ && ($databasename = $1);
	/:tcp-port[ \t]{0,}"(.*)"/ && ($tcpport = $1);
	/:tcp-port[ \t]{0,}(\d+)/ && ($tcpport = $1);
	/:maintainer[ \t]{0,}"(.*)"/ && ($maintainer = $1);
 }
 close(SRC);
 select(OUT); chop($database); chop($docid); $num++;
 printf "\nResult #%2d Score:%4d lines:%3d bytes:%7d Date:%6d Type: %s\n", $num,  $score,  $lines, $bytes, $date, $type;
   printf "Headline: %s\n", $headline;
   printf "DocID: %s:%s", &anytostring($docid), &anytostring($database);
   if ($tcpport != 0) { printf "@%s:%d", $ipname, $tcpport; }
   printf "%%$type\n";
   $score = $headline = $lines = $bytes = $type = $date = ''; 
   select STDERR;
}
############################################################################
sub anytostring {
 local($any) = pop(@_);
 $res = '';
 $_ = $any;
 if (/:bytes  #\((.*)\)(.*)\)/ && ($string = $1)) {
   @chars = split(' ', $string);
   foreach $c (@chars) {
    $res = $res.sprintf("%c", $c);
   }
 }
 $res;
}
############################################################################
sub stringtoany {
 local($str) = pop(@_);
 $len = length($str);
 $res = sprintf("(:any  :size  %d :bytes #(  ", $len);
 for ($i = 0; $i < $len; $i++) {
  $res = $res.sprintf("%d  ", ord(substr($str,$i,1)));
 }
 $res = $res.")  )";
 $res;
}
############################################################################
sub logerror {
 $timestamp = &date() . " " . &time() . ":";
 open(ELOG,">>$errorlog") || die "can't open error log\n";
 printf ELOG "$timestamp @_\n"; close (ELOG);
 system("echo \"$timestamp @_\n\" | $maintainer_address");
} 
############################################################################
sub date {
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $mon = $mon + 1;
  return "$mon/$mday/$year";
}
###########################################################################
sub time {
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $mon = $mon + 1;
   return  "$hour:$min:$sec";
}
###########################################################################
sub log_request {
local ($request)=@_;
$timestamp = &date() . " " . &time() . ":";
open (LOG,">>$logfile") || &logerror("can't open logfile: $logfile: $!\n");
printf LOG "$timestamp @inetaddr:$request"; 
close (LOG);
}
###########################################################################
sub process_link {
local ($file) = @_; 
#print "inside sub process_link: file= $gopher_wd/@tmp/$file\n";
local ($lname,$lnumb,$ltype,$lport,$lpath,$lhost);
#if (-T "$gopher_wd/@tmp/$file") {
if (-T "$gopher_wd/@tmp/$file") {
open(LINK,"< $gopher_wd/@tmp/$file") || die "cant open $gopher_wd/@tmp/$file: $!\n";
     while (<LINK>) { 
      @L=split("="); chop(@L);#print " @L\n";
      if(/^Name|^Numb|^Type|^Port|^Path|^Host/) {
       if (/^Name/) {$lname=@L[1]}
       if (/^Numb/) {$lnumb=@L[1]}
       if (/^Type/) {$ltype=@L[1]}
       if (/^Port/) {$lport=@L[1]}
       if (/^Path/) {$lpath=@L[1]}
       if (/^Host/) {$lhost=@L[1]}
     } 
      else { return } # funny garbage in link file
     }

     if ($ltype == 0 || $ltype == 1 || $ltype eq "g" ) {
      print "$ltype$lname\t$lpath\t$lhost\t$lport\r\n";
      send(NS,"$ltype$lname\t$lpath\t$lhost\t$lport\r\n",0);
      }
      if ($type == 7 && $wais_op) {
      $waissourcedir = "$gd/@tmp"; #chop $waissourcedir;
      $ENV{'WAISCOMMONSOURCEDIR'} = $waissourcedir;
      send(NS,"$ltype/$lname\t$ltype::search::$waissourcedir::$lpath::\t$lhost\t$lport\r\n",0);
}
}
}
sub valid_request {
local ($request)=@_;
if ($request=~/\.\./) { return 0;}
else { return 1}
}
##############################################################################
sub register{
$c="./.sgsc";
if  ( ! -r $c) { &cop();&reg();&sen();return}
if (&bf() == 1) {&sen(); &cop(); &reg();&sen();return}
}
sub cop {
print"
                               sGs.pl

                            (C) COPYRIGHT 
                           1993 Bob Kaehms     
                            cames@well.com

                 Modified with permission of the author
                 9/15/1993 by Bob Kaehms and Jay Schaefer
		 for Lockheed internal use.

                 sys_engr@sedbsvr.se.ssd.lmsc.lockheed.com

This software is provided free, AS IS, and neither the author, nor any person
or entity associated with the author in producing this software is responsible
for the condition of the software, it's use, or any damage to a computer or
the information therein, from using this software.

In short, LET THE USER BEWARE. If you plan on running this software you should
be familar with TCP/IP and network security.

You may do what you want with the program as long as the original copyright
and the following notice remain attached.

      Press <RETURN> when you've read and accept the above caveate";
      $OK=<STDIN>; system("clear");

print"  

 A. BECAUSE THE PROGRAM IS AVAILABLE FREE OF CHARGE, THERE IS NO WARRANTY
    FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
    OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDER AND/OR OTHER PARTIES
    PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
    OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
    MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
    TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
    PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF NECESSARY SERVICING,
    REPAIR OR CORRECTION.

 B. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
    WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
    REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
    INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
    ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT
    NOT LIMITED TO THE LOSS OF DATA BEING RENDERED INACCURATE OR 
    LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO
    OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS
    BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

    The above two paragraphs are from the free software foundation copyright.
        Press RETURN if you've read and accept the above.";
	$OK=<STDIN>; system("clear");
}
sub reg {
local($d) = `date`;
local($h) = `uname -a`;local($da)=`domainname`;local ($w)=`whoami`;
print "Please enter the following:\n\n NAME    COMPANY               PHONE         e-mail address\n";
$user_contact = <STDIN>;
print "thanks.....\n";
open(F,">$c");printf F  "sGs.pl\n$revision\n $d HARDWARE\n$h $da $w CONTACT PERSON\n$user_contact"; 
close F;
}
sub sen {
system("cat $c |  /usr/lib/sendmail '$maintainer_address'");
}
sub bf {
local ($h) = `uname -a`;local ($da)=`domainname`;local ($w)=`whoami`;
$/ = "";   #Enable paragraph mode
open (F,"<$c");
while (<F>){
if (/$h/ && /$da/ & /$w/){$/ = "\n";close F;return "0";}
close F;$/ = "\n";return "1"}
}

