Xref: feenix.metronet.com comp.infosystems.gopher:1297
Newsgroups: comp.infosystems.gopher
Path: feenix.metronet.com!news.utdallas.edu!wupost!sdd.hp.com!network.ucsd.edu!munnari.oz.au!uniwa!cujo!peter
From: peter@cujo.curtin.edu.au (Peter N Lewis)
#Subject: FREE gopher server perl script
Message-ID: <1993Mar13.054354.24201@cujo.curtin.edu.au>
Keywords: gopher commercial server license departmental budget
Organization: Curtin University of Technology
References: <1993Mar11.015639.16976@spdcc.com>
Date: Sat, 13 Mar 1993 05:43:54 GMT
Lines: 163

Well here it is, a mornings work.  It implements directories,
files and uuencoded files, as well as name mapping and links to other
locations thru the use of a simple .gophermap file which can rename
files in listings, or hide them as well as providing links to other
servers.  Its a perl script, so you'll need perl installed, but you
really should have perl installed anyway.

If you have a Mac, you can also get my FTPd program which will provide
you with a gopher server on a Mac with MacTCP (its shareware $10, thats
the difference between a one morning job like this perl script and a 6
month job like FTPd).

I'm sure this perl script can be expanded as much as anyone cares to do
it - I won't be working on it any further, so someone else had better
take over if there is any interest.  As for clients, someone else will
have to do their own, I use TurboGopher on my Mac - if the licensing fee
for that is as interesting then I may well write my own client for that
too.

Obviously, it doesn't support the Gopher+ extensions, but from what I've
seen of them, thats a good thing, they turn an elegantly simple protocol
into a horror.

The following script (which you can also pick up from
ncrpda.curtin.edu.au (gopher to it, its running there...)) is completely
free for any use, yes, if you want you can even sell it.

Enjoy,
   Peter.

#!/bin/perl

# gopherd.perl - Copyright Peter N Lewis, Mar 1993
# This script may be used and modified and distributed in any
# way you see fit as long as my name stays at the top somewhere
# and you add your changes and name somewhere in here.

# This is a trivial gopher server, it makes a directory tree available
# and allows links to other directories, and thats it.

# Its entirely free, you can do whatever you want with it, including
# sell it if y think you can get away with it.

# To use, put a line in your inetd like this:
# gopher stream tcp nowait ftp /usr/etc/gopherd.perl gopherd /home/ftp

$root="/home/ftp";
$root=$ARGV[0] if $ARGV[0];

($name, $aliases, $ourport) = getservbyname('gopher','tcp');
$ourport=70 unless $port;

chop($ourhost = `hostname`);
($ourhost, $aliases, $type, $len, $thisaddr) = gethostbyname($ourhost);

$line=<STDIN>;
chop $line;
chop $line;
$line="1" unless $line;

$line= (split('\t',$line))[0];
($type,$name)=unpack("a a*",$line);
if ($name) {
  $path="$root/$name";
} else {
  $path=$root;
}

$die=0;
$die="Invalid Line \"$line\" (contains ..)" if $path =~ m+\.\.+;
$die="Invalid Line \"$line\" (contains //)" if $path =~ m+//+;
$die="Invalid Line \"$line\" ($root doesn't start with /)" unless $path =~ m+^/+;
$die="Invalid Line \"$line\" (not a valid type)" unless $type =~ m+[016]+;

if (! $die) {
  if ($type eq '1') {
    $die = "Couldn't open directory" unless opendir(DIR,$path);
    if (! $die) {
      @mapping=();
      if (open(GOPHERMAP,"<$path/.gophermap")) {
        @mapping=<GOPHERMAP>;
        foreach (@mapping) {
          chop;
        }
        close(GOPHERMAP);
      }
      @output=();
      foreach (@mapping) {
        if (/^\t(.*)/) { @output=(@output, $1); }
      }
      while ($entry= readdir(DIR)) {
        ($char)=unpack("c",$entry);
        if ($char != 46) {
          if (-d "$path/$entry") {
            $stype="1";
          } elsif (-B _) {
            $stype="6";
          } else {
            $stype="0";
          }
          $sname=$entry;
          $spath="$path/$entry";
          $spath=$1 if $spath =~ m+$root/(.*)+;
          $shost=$ourhost;
          $sport=$ourport;
          $putout=0;
          foreach (@mapping) {
            @map=split(/\t/);
            if ($entry eq $map[0]) {
              if ($map[1]) {
                ($mtype, $mname)=unpack("a a*",$map[1]);
                $stype=$mtype unless $mtype eq "X";
                $sname=$mname if $mname;
                $spath=$map[2] if $map[2];
                $shost=$map[3] if $map[3];
                $sport=$map[4] if $map[4];
              } else {
                $stype="X";
              }
            }
          }
          $putout="$stype$sname\t$stype$spath\t$shost\t$sport";
          @output = (@output, $putout) unless $stype eq "X";
        }
      }

sub byname {
  ($at, $an)=unpack("a a*",$a);
  ($bt, $bn)=unpack("a a*",$b);
  $an =~ tr/A-Z/a-z/;
  $bn =~ tr/A-Z/a-z/;
  $an cmp $bn;
}
      @output = sort byname @output;
      foreach (@output) { print "$_\r\n"; }
      closedir(DIR);
    }
  } else {
    if ($type eq '0') {
      $die="Couldn't open file" unless open (FILE, "<$path");
    } else {
      $die="Couldn't open uuencoded file" unless open (FILE, "uuencode $name <$p
ath|");
    }
    if (! $die) {
      while (<FILE>) {
        chop;
        print "$_\r\n";
      }
      close (FILE);
    }
  }
}

if ($die) {
  print "0Gopher: $die\r\n";
}

print(".\r\n");

-- 
_______________________________________________________________________
Peter N Lewis <peter@ncrpda.curtin.edu.au>           Ph: +61 9 368 2055