From 961ce1c2fa0e71e5ffc0c16a1d4fa58802a36a1c Mon Sep 17 00:00:00 2001
From: mdw <mdw>
Date: Fri, 30 Jul 1999 18:46:38 +0000
Subject: [PATCH] New CGI script for browsing installed software and
 documentation.

---
 perl/Info.pm     | 217 ++++++++++++++++++++++++++++++++++++
 perl/Makefile.am |  56 ++++++++++
 perl/SWCGI.pm    | 183 +++++++++++++++++++++++++++++++
 perl/SWDoc.pm    |  77 +++++++++++++
 perl/SWInfo.pm   | 157 +++++++++++++++++++++++++++
 perl/SWList.pm   | 225 ++++++++++++++++++++++++++++++++++++++
 perl/SWMan.pm    | 326 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 perl/sw-cgi.1    | 281 +++++++++++++++++++++++++++++++++++++++++++++++
 perl/sw.conf     |  12 ++
 perl/sw.in       |  83 ++++++++++++++
 10 files changed, 1617 insertions(+)
 create mode 100644 perl/Info.pm
 create mode 100644 perl/Makefile.am
 create mode 100644 perl/SWCGI.pm
 create mode 100644 perl/SWDoc.pm
 create mode 100644 perl/SWInfo.pm
 create mode 100644 perl/SWList.pm
 create mode 100644 perl/SWMan.pm
 create mode 100644 perl/sw-cgi.1
 create mode 100644 perl/sw.conf
 create mode 100644 perl/sw.in

diff --git a/perl/Info.pm b/perl/Info.pm
new file mode 100644
index 0000000..c9d926d
--- /dev/null
+++ b/perl/Info.pm
@@ -0,0 +1,217 @@
+# -*-perl-*-
+#
+# $Id: Info.pm,v 1.1 1999/07/30 18:46:36 mdw Exp $
+#
+# Manipulation and reading of Info files
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: Info.pm,v $
+# Revision 1.1  1999/07/30 18:46:36  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Package preamble -----------------------------------------------------
+
+package Info;
+use IO;
+use POSIX;
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(setpath);
+
+#----- Low-level twiddling --------------------------------------------------
+
+@infopath = ("/usr/info");
+
+# --- @setpath(PATH...)@ ---
+#
+# Sets the Info search path.
+
+sub setpath(@) {
+  @infopath = @_;
+}
+
+# --- @getname(INFO)@ ---
+#
+# Given the name of an Info manual, find the actual file.
+
+
+sub getname($) {
+  my ($file) = @_;
+
+  foreach my $p (@infopath) {
+    my $f = "$p/$file";
+
+    foreach my $suff ("", "-info", ".info") {
+      return $f . $suff if -r $f . $suff;
+      return $f . $suff . ".gz" if -r $f . $suff . ".gz";
+    }
+  }
+  return undef;
+}
+
+# --- @snarf(FILE)@ ---
+#
+# Snarf a file into a string, given its name.  Handles compressed files.
+
+sub snarf($) {
+  my ($f) = @_;
+  local $/ = undef;
+  my $snarf;
+
+  if ($f =~ /\.gz$/) {
+    my $p = IO::Pipe->new();
+    my $kid = fork();
+    defined($kid) or return undef;
+    if ($kid == 0) {
+      $p->writer();
+      dup2($p->fileno(), 1);
+      exec("gzip", "-dc", $f);
+      exit(127);
+    }
+    $p->reader();
+    $snarf = $p->getline();
+    $p->close();
+    waitpid($kid, 0);
+  } else {
+    my $fh = IO::File->new($f, O_RDONLY) or return undef;
+    $snarf = $fh->getline();
+    $fh->close();
+  }
+  return $snarf;
+}
+
+#----- An Info-file object --------------------------------------------------
+
+# --- @node(NAME)@ ---
+#
+# Picks an individual node out of an Info file.
+
+sub node {
+  my ($me, $node) = @_;
+  my $offset = 0;
+  my $file;
+  my $chunk;
+
+  # --- If there's an index, it will help me find the node ---
+
+  if ($me->{index}) {
+    $offset = $me->{index}{lc($node)};
+
+    # --- Maybe the offset is into a different file ---
+
+    if ($me->{indir}) {
+      my $loff = 0;
+      PAIR: foreach my $pair (@{$me->{indir}}) {
+	if ($pair->[0] <= $offset) {
+	  ($loff, $file) = @$pair;
+	} else {
+	  last PAIR;
+	}
+      }
+      return undef unless $file;
+      $offset -= $loff;
+    }
+  }
+
+  # --- Fetch the file ---
+
+  if ($file) {
+    my $fn;
+
+    $fn = "$me->{dir}/$file", -r $fn or
+      $fn = "$me->{dir}/$file.gz", -r $fn or
+	return undef;
+    
+    if ($me->{cache}{$fn}) {
+      $file = $me->{cache}{$fn};
+    } else {
+      $file = $me->{cache}{$fn} = snarf($fn) or return undef;
+    }
+  } else {
+    $file = $me->{base};
+  }
+
+  # --- Dig through the file to find the right node ---
+
+  GASP: for (;;) {
+    pos $file = $offset;
+    if ($file =~ / \G .*\n
+                   ([^\n]* Node:\ *
+		    \Q$node\E
+		    [.,\n\t] [^]*)
+	           (?:|\Z) /igsx) {
+      $chunk = $1;
+      last GASP;
+    }
+    $offset = 0, next GASP if $offset;
+    last GASP;
+  }
+
+  return $chunk;
+}
+
+# --- @load(NAME)@ ---
+#
+# Loads a file into an Info object.
+
+sub load {
+  my ($me, $file) = @_;
+  my $f = getname($file) or return undef;
+  my $c = snarf($f) or return undef;
+
+  # --- Read the index, and maybe snarf in the indirection file ---
+
+  if (my ($index) = ($c =~ /\nTag Table:\n([^]*)\nEnd Tag Table\n/s)) {
+    my %index = ();
+    while ($index =~ /Node: *([^\n]*)(\d+)\n/sg) { $index{lc($1)} = $2; }
+    $me->{index} = \%index;
+    if ($index =~ /^\(Indirect\)/ and
+	my ($indir) = ($c =~ /\nIndirect:\n([^]*)\n/s)) {
+      my @indir = ();
+      while ($indir =~ /([^\n:]*): *(\d+)\n/sg) { push(@indir, [$2, $1]); }
+      $me->{indir} = \@indir;
+    }
+  }
+
+  ($me->{dir} = $f) =~ s:/[^/]*$::;
+  $me->{base} = $c;
+  return $me;
+}
+
+# --- @new([NAME])@ ---
+#
+# Makes a new Info file and returns it to the caller.
+
+sub new {
+  my ($class, $file) = @_;
+  my $me = bless {}, $class;
+  return $me->load($file) if $file;
+  return $me;
+}
+
+#----- That's all, folks ----------------------------------------------------
+
+1;
diff --git a/perl/Makefile.am b/perl/Makefile.am
new file mode 100644
index 0000000..69cffb5
--- /dev/null
+++ b/perl/Makefile.am
@@ -0,0 +1,56 @@
+## -*-makefile-*-
+##
+## $Id: Makefile.am,v 1.1 1999/07/30 18:46:36 mdw Exp $
+##
+## Build and install Perl bits of `sw'.
+##
+## (c) 1999 EBI
+##
+
+##----- Licensing notice ----------------------------------------------------
+##
+## This file is part of sw-tools.
+##
+## sw-tools is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+## 
+## sw-tools is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+## 
+## You should have received a copy of the GNU General Public License
+## along with sw-tools; if not, write to the Free Software Foundation,
+## Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+##----- Revision history ----------------------------------------------------
+##
+## $Log: Makefile.am,v $
+## Revision 1.1  1999/07/30 18:46:36  mdw
+## New CGI script for browsing installed software and documentation.
+##
+
+AUTOMAKE_OPTIONS = foreign
+
+cgidir = ${exec_prefix}/cgi-bin
+
+bin_SCRIPTS = sw-tidy
+cgi_SCRIPTS = sw
+man_MANS = sw-tidy.1 sw-cgi.1
+pkgdata_DATA = \
+	SW.pm SWConfig.pm SWCGI.pm Info.pm \
+	SWList.pm SWDoc.pm SWMan.pm SWInfo.pm
+noinst_DATA = sw.conf
+EXTRA_DIST = \
+	sw.conf \
+	SW.pm SWCGI.pm Info.pm \
+	SWList.pm SWDoc.pm SWMan.pm SWInfo.pm \
+	$(man_MANS)
+
+install-data-hook:
+	[ -r $(datadir)/sw.conf ] || \
+		@INSTALL_DATA@ $(srcdir)/sw.conf $(datadir)/sw.conf
+
+##----- That's all, folks ---------------------------------------------------
diff --git a/perl/SWCGI.pm b/perl/SWCGI.pm
new file mode 100644
index 0000000..2e28455
--- /dev/null
+++ b/perl/SWCGI.pm
@@ -0,0 +1,183 @@
+# -*-perl-*-
+#
+# $Id: SWCGI.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $
+#
+# Miscellaneous CGI support functions
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SWCGI.pm,v $
+# Revision 1.1  1999/07/30 18:46:37  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Package header -------------------------------------------------------
+
+package SWCGI;
+
+use Exporter;
+use SWConfig;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(barf %Q $ref);
+@EXPORT_OK = qw(read);
+%EXPORT_TAGS = (layout => [qw(header footer)],
+		debug => [qw(dumphash)]);
+
+Exporter::export_ok_tags(qw(layout debug));
+
+#----- Layout control -------------------------------------------------------
+
+$header = 0;
+
+# --- @header(TITLE)@ --
+#
+# Emit an HTML header.  This can be customized as required.  Something
+# sensible happens if a header has already been emitted.
+
+sub header($) {
+  my ($title) = @_;
+  if ($header) {
+    print <<EOF;
+<hr><h1>
+$title
+</h1>
+EOF
+  } else {
+    print <<EOF;
+Content-Type: text/html
+
+<!doctype html public "-//W3C//DTD HTML 3.2 Final//EN">
+<html><head><title>
+$title
+</title></head><body bgcolor=white>
+EOF
+    $header = 1;
+  }
+}
+
+# --- @footer@ ---
+#
+# Emit an HTML footer to a page.
+
+sub footer() {
+  print <<EOF;
+<hr><div align=right><font size="-1"><i>
+sw.cgi ($C{pkg} $C{version})
+</i></font></div></body></html>
+EOF
+}
+
+#----- Useful functions -----------------------------------------------------
+
+# --- @barf(ERROR)@ ---
+#
+# Reports an error and exits.  The error is lovingly trapped in an HTML
+# wrapper so that it can appropriately terrify a user.
+
+sub barf($) {
+  my ($error) = @_;
+  header("Internal error in sw.cgi");
+  print <<EOF;
+<h3>
+Internal error in sw.cgi
+</h3>
+
+<p>$error
+
+<p>This may be a result of a broken link or a server misconfiguration,
+or it might be a bug in sw.cgi itself.  Please report this problem to
+your <a href="mailto:$ENV{SERVER_ADMIN}">server administrator</a> to
+sort out.
+EOF
+  footer();
+  exit;
+}
+
+#----- Debugging ------------------------------------------------------------
+
+# --- @dumphash(HASH)@ ---
+#
+# Dumps a hash out in a tabular format.
+
+sub dumphash(\%) {
+  my ($h) = @_;
+  print "<table border=1 bgcolor=lightgrey>\n";
+  foreach my $k (sort(keys(%$h))) {
+    print "  <tr><th align=left>$k<td>$h->{$k}\n";
+  }
+  print "</table>\n";
+}
+
+#----- Argument reading -----------------------------------------------------
+
+%Q = ();
+$ref = "/cgi-bin/sw.cgi";
+
+# --- @read([QUERY])@ ---
+#
+# Reads arguments from a web server.
+
+sub read(;$) {
+  my ($q) = @_;
+
+  # --- Read in the query string ---
+  #
+  # If a query is supplied as an argument then use that.  Otherwise use the
+  # `REQUEST_METHOD' variable.  Accept `GET' or `POST', and use the
+  # appropriate method for getting the data.  If the variable wasn't set,
+  # read the command line arguments.  If it's something I don't understand,
+  # raise an error.
+
+  unless (defined($q)) {
+    my $meth = $ENV{"REQUEST_METHOD"};
+    if ($meth eq "GET") {
+      $q = $ENV{"QUERY_STRING"};
+    } elsif ($meth eq "PUT") {
+      local $/ = undef;
+      $q = <STDIN>;
+    } elsif (!defined($meth)) {
+      $q = join("&", @ARGV);
+    } else {
+      barf("unsupported requst method `$meth'");
+    }
+  }
+
+  # --- Parse it up into little bits ---
+
+  foreach my $pair (split(/\&/, $q)) {
+    my ($k, $v) = split(/\=/, $pair);
+    $k =~ tr/+/ /; $k =~ s/\%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
+    $v =~ tr/+/ /; $v =~ s/\%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
+    $Q{$k} = $v;
+  }
+
+  # --- Set other bits of data from this ---
+
+  $ENV{"SCRIPT_NAME"} and $ref = $ENV{"SCRIPT_NAME"};
+}
+
+#----- That's all, folks ----------------------------------------------------
+
+1;
diff --git a/perl/SWDoc.pm b/perl/SWDoc.pm
new file mode 100644
index 0000000..d87da58
--- /dev/null
+++ b/perl/SWDoc.pm
@@ -0,0 +1,77 @@
+# -*-perl-*-
+#
+# $Id: SWDoc.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $
+#
+# Display documentation files
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SWDoc.pm,v $
+# Revision 1.1  1999/07/30 18:46:37  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Package preamble -----------------------------------------------------
+
+package SWDoc;
+
+use IO;
+use POSIX;
+use SWConfig;
+use SWCGI qw(:DEFAULT :layout);
+use SWMan;
+
+#----- Actions provided -----------------------------------------------------
+
+sub doc {
+  my $file = "$C{doc}/$Q{pkg}";
+  barf("illegal filename `$file'") if $file =~ m:\./:;
+  my $fh = IO::File->new($file, O_RDONLY) or
+    barf("couldn't open `$file': $!");
+  header("Local documentation for package $Q{pkg}");
+  print("<h3>Local documentation for package $Q{pkg}</h3>\n");
+  print("<pre>\n");
+
+  while (my $line = $fh->getline()) {
+    last if $line =~ //;
+    $line =~ s/\&/&amp;/g;
+    $line =~ s/\</&lt;/g;
+    $line =~ s/\>/&gt;/g;
+    $line =~ s!(http|ftp)://[^]&)\s]*[^]&).,\s\']!<a href="$&">$&</a>!g;
+    $line =~ s!info:([^]&)\s]*[^]&).,\s\'\"])!<a href="$ref?act=info&file=$1&node=Top">$&</a>!g;
+    $line =~ s![^\s()&;{}.,\`\"][^\s()&;{}\`\"]*\@[^\s()&;{}\'\"]*[^\s()&;{}.,\'\"]!<a href="mailto:$&">$&</a>!g;
+    $line =~ s!([-_.\w]+)\((\d+\w*)\)!SWMan::subst("$1($2)", $1, $2)!eg;
+    print $line;
+  }
+  print "</pre>\n";
+  footer();
+}
+
+#----- Register actions -----------------------------------------------------
+
+$main::ACT{"doc"} = \&doc;
+
+#----- That's all, folks ----------------------------------------------------
+
+1;
diff --git a/perl/SWInfo.pm b/perl/SWInfo.pm
new file mode 100644
index 0000000..04898df
--- /dev/null
+++ b/perl/SWInfo.pm
@@ -0,0 +1,157 @@
+# -*-perl-*-
+#
+# $Id: SWInfo.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $
+#
+# Read and output GNU Info files
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SWInfo.pm,v $
+# Revision 1.1  1999/07/30 18:46:37  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Package preamble -----------------------------------------------------
+
+package SWInfo;
+
+use IO;
+
+use SWConfig;
+use SWCGI qw(:DEFAULT :layout);
+use SWMan;
+use Info;
+
+#----- Useful functions -----------------------------------------------------
+
+# --- @subst(IREF, FILE, INFO)@ ---
+#
+# Given an Info reference and the name of the current Info file, returns an
+# HTML anchor which represents the link.
+
+sub subst($$$) {
+  my ($iref, $file, $i) = @_;
+  my $node;
+  my $dir;
+  my $tail = "";
+
+  # --- Dig out the node and file being referred to ---
+
+  if ($iref =~ /:$/) {
+    $tail = ":";
+    $iref = $`;
+  }
+  my $oref = $iref;
+  $iref =~ s/\s+/ /g;
+  if ($iref =~ /^.+: *(.+)$/) { $iref = $1; }
+  if ($iref =~ /(?:\(([^\)]*)\))?(.*)$/) {
+    $file = $1 || $file;
+    $node = $2 || "Top";
+  } else {
+    $node = $iref;
+  }
+
+  # --- Transform it into something that won't get mangled ---
+
+  $node =~ s/[+&=%]|[^ -~]/sprintf("%%%02x", ord($&))/eg;
+  $node =~ tr/ /+/;
+
+  ($dir = $i->{dir}) =~ s:$C{prefix}/info/?::;
+  $dir = "&dir=$dir" if $dir;
+
+  return "<a href=\"$ref?act=info&file=$file&node=$node$dir\">$oref</a>$tail";
+}
+
+#----- Actions --------------------------------------------------------------
+
+sub info {
+  my $file = $Q{file} || "dir";
+  my $node = $Q{node} || "Top";
+  my $dir = $Q{dir} || "";
+  my $out;
+
+  # --- Read the node in ---
+
+  Info::setpath("$C{prefix}/info");
+
+  "$dir/$file" =~ m:\./: and
+    barf("bad filename `$dir/$file'");
+  my $i = (($dir && Info->new("$dir/$file")) ||
+	   Info->new($file))
+    or barf("couldn't find info file `$file'");
+  my $n = $i->node($node) or
+    barf("info file `$file' doesn't contain node `$node'");
+
+  # --- Now translate the node into HTML, first line first ---
+
+  $n =~ s/\&/&amp;/;
+  $n =~ s/\</&lt;/;
+  $n =~ s/\>/&gt;/;
+  $n =~ s/\A( [^\n]* Next:\ *) ([^,\n]*) / $1 . subst($2, $file, $i) /eix;
+  $n =~ s/\A( [^\n]* Prev:\ *) ([^,\n]*) / $1 . subst($2, $file, $i) /eix;
+  $n =~ s/\A( [^\n]* Up:\ *) ([^,\n]*) / $1 . subst($2, $file, $i) /eix;
+
+  # --- Grind through picking up any notes ---
+
+  $out = "";
+
+  for (;;) {
+    if ($n =~ /(\*Note\s*)([^:]*: *(?:\([^\)]*\))?[^.,;:]*)([.,;:])/i) {
+      $out .= $` . $1 . subst($2, $file, $i) . $3;
+      $n = $';
+    } else {
+      last;
+    }
+  }
+
+  # --- If there's a menu then process that ---
+
+  if ($n =~ /\n\* *Menu:/s) {
+    $out .= $` . $&;
+    $n = $';
+    for (;;) {
+      if ($n =~ /(\n\* *)([^:]*: *(?:\([^\)]*\))?[^.,;:]*)([.,;:])/) {
+	$out .= $` . $1 . subst($2, $file, $i) . $3;
+	$n = $';
+      } else {
+	last;
+      }
+    }
+  }
+  $out .= $n;
+
+  $out =~ s!(http|ftp)://[^]&)\s]*[^]&).,\s\'\"]!<a href="$&">$&</a>!g;
+  $out =~ s![^\s()&;{}.,\`\"][^\s()&;{}\`\"]*\@[^\s()&;{}\'\"]*[^\s()&;{}.,\'\"]!<a href="mailto:$&">$&</a>!g;
+  $out =~ s!([-_.\w]+)\((\d+\w*)\)!SWMan::subst("$1($2)", $1, $2)!eg;
+
+  header("Info: ($file)$node");
+  print("<pre>\n$out</pre>\n");
+  footer();
+}
+
+#----- Actions provided -----------------------------------------------------
+
+$main::ACT{"info"} = \&info;
+
+#----- That's all, folks ----------------------------------------------------
diff --git a/perl/SWList.pm b/perl/SWList.pm
new file mode 100644
index 0000000..e2e83be
--- /dev/null
+++ b/perl/SWList.pm
@@ -0,0 +1,225 @@
+# -*-perl-*-
+#
+# $Id: SWList.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $
+#
+# Create the main list of installed packages
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SWList.pm,v $
+# Revision 1.1  1999/07/30 18:46:37  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Package header -------------------------------------------------------
+
+package SWList;
+
+use IO;
+use POSIX;
+
+use SWConfig;
+use SW;
+use SWCGI qw(:DEFAULT :layout);
+
+#----- Main code ------------------------------------------------------------
+
+# --- @list@ ---
+#
+# Action to output the installed software list.
+
+%archmap = ( "linux" => 'l',
+	     "solaris" => 's',
+	     "sunos" => 's',
+	     "irix" => 'i',
+	     "alpha" => 'a',
+	     "hpux" => 'h' );
+	     
+
+sub list {
+
+  my @arch = ();
+  my $narch = 0;
+
+  # --- Read the architecture table and assign mnemonic-ish letters ---
+
+  {
+    my $a = IO::File->new("$C{datadir}/archtab") or
+      barf("couldn't open archtab: $!");
+    my %mn = ();
+    LINE: while (my $line = $a->getline()) {
+
+      # --- Skip comments and boring things ---
+
+      chomp($line);
+      next LINE if $line =~ /^\s*$/ || $line =~ /^\s*\#/;
+
+      # --- Break into components ---
+
+      my ($arch, $host) = split(" ", $line, 3);
+
+      # --- Assign a mnemonic character ---
+      #
+      # In dire cases, this will choose multiple characters.  Oh, well.  If
+      # you have more than 26 architectures to maintain, this is the least of
+      # your worries.
+
+      my $mn = "";
+      my $hi;
+      foreach my $k (keys(%archmap)) {
+	if (index($arch, $k) >= 0 && !$mn->{$archmap{$k}}) {
+	  $mn = $archmap{$k};
+	  last;
+	}
+      }
+      unless ($mn) {
+	for (my $i = 0; $i < length($arch); $i++) {
+	  my $ch = lc(substr($arch, $i, 1));
+	  next unless $ch =~ /[a-z]/;
+	  $mn = $ch, last unless $mn{$ch};
+	}
+      }
+      if ($mn) {
+	($hi = $arch) =~ s:$mn:<u>$mn</u>:;
+      } else {
+	for ($mn = "a"; $mn{$mn}; $mn++) { }
+	$hi = "$arch (<u>$mn</u>)";
+      }
+      push(@arch, { arch => $arch, host => $host, mn => $mn, hi => $hi });
+    }
+  }
+  @arch = sort { length($a->{mn}) <=> length($b->{mn}) ||
+		   $a->{mn} cmp $b->{mn} } @arch;
+  $narch = @arch;
+
+  # --- Emit a header ---
+
+  header("Installed software");
+
+  print <<EOF;
+<h3>Documentation</h3>
+<ul>
+<li><a href="$ref?act=man">Manual pages</a>
+<li><a href="$ref?act=info">GNU Info</a>
+</ul>
+<hr>
+<h3>Installed software</h3>
+<table>
+<tr align=left>
+  <th rowspan=2>Package
+  <th rowspan=2>Version
+  <th rowspan=2 colspan=2>Maintainer
+  <th colspan=$narch>Architectures
+  <th rowspan=2>Date installed
+  <th rowspan=2>Doc
+EOF
+
+  # --- Spit out the archtecture mnemonics ---
+
+  print "<tr align=left>\n  ";
+  foreach my $a (@arch) { print "<th>" . $a->{mn}; }
+  print "\n";
+
+  # --- Iterate through the installed packages ---
+
+  my $sw = SW->new();
+  foreach my $pkg ($sw->list()) {
+    my $m = $sw->get($pkg);
+    print("<tr>\n");
+
+    # --- The package and version number are easy ---
+
+    print("  <td>$m->{package}\n");
+    print("  <td>$m->{version}\n");
+
+    # --- Resolve the maintainer into a sensible real name ---
+
+    {
+      my $maint = $m->{"maintainer"};
+      my @pw = getpwnam($maint);
+      my ($gecos) = split(/,/, $pw[6], 2);
+      my $addr = $maint . ($C{domain} && "\@" . $C{domain});
+      print("  <td>$gecos<td>&lt;<a href=\"mailto:$addr\">$addr</a>&gt;\n");
+    }
+
+    # --- Dump out the architectures ---
+    #
+    # Assume that the names aren't ambiguous.
+
+    {
+      my %a = ();
+      foreach my $ar (split(/[\s,]+/, $m->{"arch"})) {
+	next unless $ar;
+	foreach my $a (@arch) {
+	  if ($a->{arch} =~ /^$ar/) {
+	    $a{$a->{arch}} = 1;
+	    last;
+	  }
+	}
+      }
+
+      print("  ");
+      foreach my $a (@arch) {
+	if ($a{$a->{arch}}) {
+	  print("<td>", $a->{mn});
+	} else {
+	  print("<td>");
+	}
+      }
+      print("\n");
+    }
+
+    # --- Print the date ---
+
+    print("  <td>$m->{date}\n");
+
+    # --- If the documentation file exists, put a link in ---
+
+    if (-r "$C{doc}/$pkg") {
+      print("  <td><a href=\"$ref?act=doc&pkg=$pkg\">Yes</a>\n");
+    } else {
+      print("  <td>No\n");
+    }
+  }
+
+  # --- Finish up ---
+
+  print "</table>\n";
+
+  # --- Emit a legend for the architecture lists ---
+
+  print "<p><b>Architectures:</b>\n";
+  foreach my $a (@arch) {
+    print $a->{hi}, "\n";
+  }
+  footer();
+}
+
+#----- Register actions -----------------------------------------------------
+
+$main::ACT{"list"} = \&list;
+
+#----- That's all, folks ----------------------------------------------------
+
+1;
diff --git a/perl/SWMan.pm b/perl/SWMan.pm
new file mode 100644
index 0000000..23f0104
--- /dev/null
+++ b/perl/SWMan.pm
@@ -0,0 +1,326 @@
+# -*-perl-*-
+#
+# $Id: SWMan.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $
+#
+# Display and other fiddling of manual pages
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: SWMan.pm,v $
+# Revision 1.1  1999/07/30 18:46:37  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Package preamble -----------------------------------------------------
+
+package SWMan;
+
+use IO;
+use POSIX;
+use DirHandle;
+use Exporter;
+
+use SWConfig;
+use SWCGI qw(:DEFAULT :layout);
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(subst check);
+
+#----- Useful functions -----------------------------------------------------
+
+%mandb = ();
+
+# --- @mans(SECTION)@ ---
+#
+# Returns a reference to a list of manual pages in the given section.
+
+sub mans($) {
+  my ($sec) = @_;
+  $mandb{$sec} and return $mandb{sec};
+
+  my $d = DirHandle->new("$C{prefix}/man/man$sec") or return undef;
+  my @f;
+  while (my $f = $d->read()) {
+    push(@f, $f);
+  }
+  $mandb{$sec} = \@f;
+  return \@f;
+}
+
+# --- @check(NAME, SECTION)@ ---
+#
+# See whether there's a manpage called NAME with section SECTION.
+
+sub check($$) {
+  my $pre = "$C{prefix}/man/man";
+  my ($man, $sec) = @_;
+  my $f;
+
+  # --- Quick check for obvious things ---
+
+  my ($base) = ($sec =~ /^(\d+)/);
+  $f = "$pre$base/$man.$sec";
+  -r $f and return $f; $f .= ".gz"; -r $f and return $f;
+
+  # --- Snarf the appropriate filename list ---
+
+  my $fs = mans($base) or return undef;
+  foreach my $f (@$fs) {
+    $f =~ /^$man\.$sec\w+(\.gz)?$/ and return "$C{prefix}/man/man$base/$f";
+  }
+  return undef;
+}
+
+# --- @subst(STRING, NAME, SECTION)@ ---
+#
+# If NAME(SECTION) is a manual page, return the STRING appropriately wrapped
+# in an anchor element; otherwise return it unmolested.
+
+sub subst($$$) {
+  my ($s, $n, $sec) = @_;
+  check($n, $sec) and
+    return "<a href=\"$ref?act=man&man=$n&sec=$sec\">$s</a>";
+  return "$s";
+}
+
+# --- @sections()@ ---
+#
+# Return a list of manual sections.
+
+@sectionlist = ();
+
+sub sections() {
+  return @sectionlist if @sectionlist;
+  my @s = ();
+  my $d = DirHandle->new("$C{prefix}/man") or
+    barf("couldn't open man directory: $!");
+  while ($f = $d->read()) {
+    next if $f !~ /^man/ || !-d "$C{prefix}/man/$f";
+    push(@s, $');
+  }
+  return (@sectionlist = sort(@s));
+}
+
+#----- Display a quick section index ----------------------------------------
+
+sub quickie {
+  print "Quick section index:\n";
+  foreach $s (sections()) {
+    print "<a href=\"$ref?act=man&sec=$s\">$s</a>\n";
+  }
+}
+
+#----- Display indices for manual sections ----------------------------------
+
+sub dosection($) {
+  my ($sec) = @_;
+  my @m = ();
+
+  barf("illegal section `$sec'") if $sec =~ m:/:;
+
+  # --- Snarf the list of manual pages in this section ---
+
+  {
+    my $d = DirHandle->new("$C{prefix}/man/man$sec") or
+      barf("couldn't read directory `$C{prefix}/man/man$sec': $!");
+    while (my $f = $d->read()) {
+      my ($man, $sec) = split(/\./, $f, 3);
+      push(@m, "$man($sec)") if $sec;
+    }
+  }
+
+  # --- Sort and emit the index ---
+
+  print("<h4>Section $sec</h4>\n<table>");
+
+  {
+    my $col = 0;
+    foreach my $m (sort(@m)) {
+      my ($man, $sec) = $m =~ /^(.*)\((.*)\)$/;
+      $col or print("<tr>\n");
+      print("<td><a href=\"$ref?act=man&man=$man&sec=$sec\">$m</a>\n");
+      $col = ($col + 1) % 5;
+    }
+  }
+
+  print("</table>\n");
+}
+
+sub section {
+  my $sec = $Q{"sec"};
+  header("Index of manual section $sec");
+  quickie(); print "<hr>\n";
+  dosection($sec);
+  print "<hr>\n"; quickie();;
+  footer();
+}
+
+sub index {
+  header("Manual page index");
+  print("<h3>Manual page index</h3>\n");
+  foreach my $s (sections()) { dosection($s); }
+  footer();
+}  
+
+#----- Display a manual page ------------------------------------------------
+
+sub man {
+  my ($man, $sec) = ($Q{"man"}, $Q{"sec"});
+
+  $sec or &index(), return;
+  $man or &section(), return;
+
+  my $file = check($man, $sec) or
+    barf("no manual page $man($sec)");
+  barf("illegal filename `$file'") if $file =~ m:\./:;
+
+  # --- Read the manual page ---
+
+  my $p = IO::Pipe->new();
+  my $kid = fork();
+  defined($kid) or barf("fork failed: $!");
+  if ($kid == 0) {
+    $p->writer();
+    dup2($p->fileno(), 1);
+    chdir("$C{prefix}/man");
+    if ($file =~ /\.gz$/) {
+      $pp = IO::Pipe->new;
+      $kkid = fork();
+      defined($kid) or exit(127);
+      if ($kkid == 0) {
+	$pp->writer();
+	dup2($pp->fileno, 1);
+	exec("gzip", "-dc", $file);
+	exit(127);
+      }
+      exec("nroff", "-man");
+    } else {
+      exec("nroff", "-man", $file);
+    }
+    exit(127);
+  }
+  $p->reader();
+
+  # --- Spit out the manual page now ---
+
+  header("Manual page $Q{man}($Q{sec})");
+  quickie(); print "<hr>\n";
+  print "<pre>\n";
+  while (my $line = $p->getline()) {
+    chomp $line;
+
+    # --- Grind through the line turning it into HTML ---
+
+    {
+      my $state = "";
+      my $l = "";
+
+      for (my $i = 0; $i < length($line); $i++) {
+	my $ch = substr($line, $i, 1);
+	my $nstate = "";
+
+	# --- Sort out overstriking ---
+
+	if (substr($line, $i + 1, 1) eq "") {
+	  my ($italic, $bold) = (0, 0);
+	  $ch eq "_" and $italic = 1;
+	  $ch eq substr($line, $i + 2, 1) and $bold = 1;
+	  $ch = substr($line, $i + 2, 1);
+	  while (substr($line, $i + 1, 1) eq "") { $i += 2; }
+	  if ($italic && $bold) {
+	    $nstate = $state ? $state : "b";
+	  } elsif ($italic) {
+	    $nstate = "i";
+	  } elsif ($bold) {
+	    $nstate = "b";
+	  }
+	}
+	$state ne $nstate and
+	  $l .= ($state && "</$state>") . ($nstate && "<$nstate>");
+	$state = $nstate;
+
+	# --- Translate the character if it's magical ---
+
+	$ch eq "&" and $ch = "&amp;";
+	$ch eq "<" and $ch = "&lt;";
+	$ch eq ">" and $ch = "&gt;";
+	$l .= $ch;
+      }
+      $state and $l .= "</$state>";
+
+      # --- Now find manual references in there ---
+      #
+      # I don't use /x regexps very often, but I think this is a good excuse.
+
+      $l =~ s! ((?:\<[bi]\>)*)		# Leading highlighting tags
+	       ([-_.\w]+)		# Various plausible manual name chars
+	       ((?:\</[bi]\>)*		# Closing highlighting tags
+		(?:\<[bi]\>)*		# And opening ones again
+		\(			# An open parenthesis
+		(?:\<[bi]\>)*)		# More opening highlights
+	        (\d+\w*)		# The section number
+	        ((?:\</[bi]\>)*		# Close highlights
+		 \)			# Close parens
+                 (?:\</[bi]\>)*)	# Finally more closing tags
+	     ! subst($&, $2, $4) !egx;
+
+      # --- And email and hypertext references too ---
+
+      $l =~ s! ((?:\<[bi]\>)*)		# Leading highlighting
+	       ((?:http|ftp)		# A protocol name
+		://			# The important and obvious bit
+		[^]&)\s]+		# Most characters are allowed
+		[^]&).,\s\'\"])		# Don't end on punctuation
+  	       ((?:\</[bi]\>)*)		# Closing tags, optional
+  	     !<a href="$2">$&</a>!gx;
+
+      $l =~ s! ((?:\<[bi]\>)*)
+               ( [^\s()&;{}<>,.\`\"] [^\s()&;{}<>\`\"]* \@
+                 [^\s()&;{}<>\'\"]* [^\s()&;{}<>.,\'\"])
+               ((?:\</[bi]\>)*)
+             !<a href="mailto:$2">$&</a>!gx;
+
+      # --- Done! ---
+
+      print $l, "\n";
+    }
+  }
+
+  # --- Done all of that ---
+
+  print "</pre>\n";
+  $p->close();
+  waitpid($kid, 0);
+  barf("nroff failed (exit status $?)") if $?;
+  print "<hr>\n"; quickie();;
+  footer();
+}
+
+#----- Register actions -----------------------------------------------------
+
+$main::ACT{"man"} = \&man;
+
+#----- That's all, folks ----------------------------------------------------
+
+1;
diff --git a/perl/sw-cgi.1 b/perl/sw-cgi.1
new file mode 100644
index 0000000..244ee5b
--- /dev/null
+++ b/perl/sw-cgi.1
@@ -0,0 +1,281 @@
+.\" -*-nroff-*-
+.\"
+.\" $Id: sw-cgi.1,v 1.1 1999/07/30 18:46:38 mdw Exp $
+.\"
+.\" Man page for `sw' CGI script
+.\"
+.\" (c) 1999 EBI
+.\"
+.
+.\"----- Licensing notice ---------------------------------------------------
+.\"
+.\" This file is part of sw-tools.
+.\"
+.\" sw-tools is free software; you can redistribute it and/or modify
+.\" it under the terms of the GNU General Public License as published by
+.\" the Free Software Foundation; either version 2 of the License, or
+.\" (at your option) any later version.
+.\" 
+.\" sw-tools is distributed in the hope that it will be useful,
+.\" but WITHOUT ANY WARRANTY; without even the implied warranty of
+.\" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+.\" GNU General Public License for more details.
+.\" 
+.\" You should have received a copy of the GNU General Public License
+.\" along with sw-tools; if not, write to the Free Software Foundation,
+.\" Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+.
+.\"----- Revision history ---------------------------------------------------
+.\"
+.\" $Log: sw-cgi.1,v $
+.\" Revision 1.1  1999/07/30 18:46:38  mdw
+.\" New CGI script for browsing installed software and documentation.
+.\"
+.
+.\"----- Style hacking ------------------------------------------------------
+.
+.de VS \" Start a sort-of verbatim block
+.sp 1
+.in +5n
+.nf
+.ft B
+..
+.de VE \" Stop a sort-of verbatim block
+.ft R
+.fi
+.in -5n
+.sp 1
+..
+.ie \n(.g \{\
+. fam P
+. ds mw \fR[\f(BImdw\fR]
+.\}
+.el .ds mw \fR[\fBmdw\fR]
+.ie t .ds o \(bu
+.el .ds o o
+.ds sw \fBsw\fP
+.
+.\"----- Main manual text ---------------------------------------------------
+.
+.TH sw-cgi 1 "30 July 1999" sw-tools
+.PD 1
+.
+.\"--------------------------------------------------------------------------
+.
+.SH "NAME"
+.
+sw-cgi \- CGI script for browsing installed software and documentation
+.
+.\"--------------------------------------------------------------------------
+.
+.SH "SYNOPSIS"
+.
+.IB prefix /cgi-bin/sw
+.RI [ key = value ]...
+.
+.\"--------------------------------------------------------------------------
+.
+.SH "DESCRIPTION"
+.
+The
+.B sw
+CGI script provides users with a pleasant-ish interface for browsing the
+list of locally installed software and its documentation.
+.PP
+The script picks up arguments from HTTP
+.B GET
+or
+.B POST
+requests, or from the command line (which is useful when debugging).
+Given no arguments, it emits a table of installed software read from the
+index file in
+.IB prefix /sw-index
+together with links to documentation.
+.PP
+The program assumes that any
+.I package
+has documentation stashed in
+.IB prefix /doc/ package
+in plain text format.  You can require your installers to do this by
+putting this code in a
+.B sw-precommit
+script (see the
+.B "Command reference"
+in
+.BR sw (1)
+for details):
+.VS
+# --- Ensure the documentation file exists ---
+
+if [ ! -r "$SW_PREFIX/doc/$SW_PACKAGE" ]; then
+  echo >&2 "no documentation file \`$SW_PREFIX/doc/$SW_PACKAGE'"
+  exit 1
+fi
+.VE
+Links to these documentation files are put into the table
+automatically.  The script picks out likely-looking references to other
+sources of information:
+.TP
+.I "manual pages"
+A reference of the form
+.IB name ( section )
+is suspected of being a manual page; the script looks in the manual
+directories to see if this is the case and if so inserts a hypertext
+link to the manual page.  This is the standard form for manual page
+references.
+.TP
+.I "info manuals"
+A reference of the form
+.BI info: name
+is assumed to be a reference to the GNU Info manual called
+.I name
+and an appropriate link inserted.  There isn't a standard form for Info
+references in non-Info manuals, so I've invented one.
+.TP
+.I "URLs"
+A URL which begins with one of
+.B http://
+or
+.B ftp://
+is spotted and turned into a link.  Only these two work.
+.TP
+.I "email addresses"
+Something that looks like an email address is turned into a
+.B mailto
+link.
+.PP
+Similar transformations are applied to manual pages when they're
+formatted.
+.
+.SS "Script arguments"
+The behaviour of the script is determined by the value of the
+.B act
+key.  Any of the following may be given:
+.TP
+.B list
+Emit the list of packages in tabular form.  This is the default if no
+.B act
+is given.
+.TP
+.B doc
+Format a textual documentation file.  The name of the package whose
+documentation is to be emitted is given as the value of the
+.B pkg
+key.
+.TP
+.B man
+Format a manual page, or emit a manual index.  If no
+.B sec
+key is given, an index of all manual pages in the software area is
+produced.  If
+.B sec
+is a manual page section (e.g.,
+.BR 1 ,
+not
+.BR man1 )
+but
+.B man
+is not given then an index of that particular section is emitted.  If
+both
+.B sec
+and
+.B man
+are supplied then the manual page whose name is given by the
+.B man
+key in the section given by the
+.B sec
+key is formatted (using
+.BR nroff (1))
+and displayed.  Manual page references, URLs and email addresses are
+transformed into links in the output.
+.TP
+.B info
+Format a GNU Info node.  If the
+.B file
+key is given, its value names an Info manual to open; the default is
+.BR dir .
+If the
+.B node
+key is given, its value names a node within the manual; the default is
+.BR Top .
+.TP
+.B show-config
+Emits a table showing the configuration settings which the script is
+aware of.  See
+.B Configuration
+below.  This is useful during debugging.
+.TP
+.B show-environment
+Displays the environment variables passed to the script by the Web
+server.  This is useful during debugging.
+.TP
+.B show-query
+Displays the query string passed by the Web server, decomposed into keys
+and values and decoded.  This is useful during debugging.
+.
+.SS "Configuration"
+The
+.B sw
+CGI script needs some configuration before it can do its work properly.
+Indeed, it will refuse to run until the configuration file has been
+edited.
+.PP
+The configuration file is in
+.IB prefix /share/sw.conf\fR.
+The format is simple.  A line may be empty, or a comment, in which case
+it is ignored.  Comments have 
+.RB ` # '
+as their first non-whitespace character; blank lines contain only
+whitespace.  A line may also contain a configuration variable
+assignment, of the form
+.I key
+.RB  [ = ]
+.IR value .
+The
+.I key
+may be anything you like; only certain keys make sense to the script.
+.PP
+Configuration keys currently used are:
+.TP
+.B pkg
+The name of the package in which the script came.  This is set
+automatically and you should not change the value.
+.TP
+.B version
+The version number of the package.  This is set automatically and you
+should not change the value.
+.TP
+.B edited-config-file
+Must be assigned the value
+.BR yes .
+If this is not the case the script will immediately report an error.
+The default configuration file comes with a commented-out assignment to
+this variable.
+.TP
+.B prefix
+The installation prefix where your software gets installed.  You
+shouldn't need to change this, although it's handy for debugging.
+.TP
+.BR index ", " doc " and " datadir
+The name of the index file, documentation directory and shared data
+directory respectively.  The default values of these variables are set
+automatically and you shouldn't need to change them.
+.TP
+.B domain
+Your email domain.  Set this to the domain part for email addresses of
+people at your site, and the script will generate correct links in its
+main list page.
+.
+.\"--------------------------------------------------------------------------
+.
+.SH "SEE ALSO"
+.BR sw (1),
+.BR sw-info (5).
+.
+.SH "AUTHOR"
+.
+The \*(sw program, and this manual, are \*(mw productions, in association
+with the European Bioinformatics Institute.  They were written by Mark
+Wooding <mdw@nsict.org>.  Go and ask him if you have problems.
+.
+.\"----- That's all, folks --------------------------------------------------
diff --git a/perl/sw.conf b/perl/sw.conf
new file mode 100644
index 0000000..dca2b1a
--- /dev/null
+++ b/perl/sw.conf
@@ -0,0 +1,12 @@
+# Example configuration file for `sw' Perl scripts
+#
+# The syntax is straightforward: `key = value', one per line.  Blank lines
+# and comments are ignored.
+
+# Uncomment this entry to make everything actually work
+# edited-config-file = yes
+
+# Put your mail domain in here.  This is used for working out maintainers'
+# email addresses from their user names.
+domain = ebi.ac.uk
+
diff --git a/perl/sw.in b/perl/sw.in
new file mode 100644
index 0000000..854be1f
--- /dev/null
+++ b/perl/sw.in
@@ -0,0 +1,83 @@
+#! @PERL@
+# -*-perl-*-
+#
+# $Id: sw.in,v 1.1 1999/07/30 18:46:38 mdw Exp $
+#
+# CGI interface for software installations
+#
+# (c) 1999 EBI
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of sw-tools.
+#
+# sw-tools is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# sw-tools is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with sw-tools; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Revision history -----------------------------------------------------
+#
+# $Log: sw.in,v $
+# Revision 1.1  1999/07/30 18:46:38  mdw
+# New CGI script for browsing installed software and documentation.
+#
+
+#----- Required packages ----------------------------------------------------
+
+use lib qw(@pkgdatadir@);
+
+use POSIX;
+use IO;
+
+use SWConfig;
+use SW;
+use SWCGI qw(:DEFAULT :debug);
+
+#----- Get packages implementing various actions ----------------------------
+
+BEGIN { %ACT = (); }
+use SWList;
+use SWDoc;
+use SWMan;
+use SWInfo;
+
+#----- Some built-in debugging actions --------------------------------------
+
+sub debug($\%) {
+  my ($what, $h) = @_;
+  SWCGI::header($what);
+  SWCGI::dumphash(%$h);
+  SWCGI::footer();
+}
+
+$ACT{"show-config"} = sub { debug("configuration", %C); };
+$ACT{"show-environment"} = sub { debug("configuration", %ENV); };
+$ACT{"show-query"} = sub { debug("configuration", %Q); };
+
+#----- Snarf arguments ------------------------------------------------------
+
+$C{"edited-config-file"} eq "yes" or
+  barf("Config file $C{datadir}/sw.conf hasn't been edited.");
+
+SWCGI::read();
+$act = $Q{"act"} || "list";
+if ($ACT{$act}) {
+  &{$ACT{$act}};
+} else {
+  barf("unknown action `$act'");
+}
+
+#----- That's all, folks ----------------------------------------------------
+
+exit;
-- 
2.11.0