suffix.pl and other utilities for Plexus
Gisle.Aas@nr.no
Date: Sat, 6 Nov 93 15:41:02 +0100
From: Gisle.Aas@nr.no
Message-id: <9311061441.AA10292@holt>
To: www-talk@nxoc01.cern.ch
Subject: suffix.pl and other utilities for Plexus
Reply-To: Gisle.Aas@nr.no
This is some of the utilities that I use with the Plexus 3.0j server.
You might also want to take a look at:
http://www.nr.no/demo/gateways.html.
-------------------------------------------------------------------
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 11/06/1993 13:42 UTC by aas@holt
# Source directory /nr/holt/u3/aas/HTTP
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 2702 -rw-r--r-- suffix.pl
# 849 -rw-r--r-- sh.pl
# 795 -rw-r--r-- inc.pl
# 1374 -rw-r--r-- nr-access.pl
# 114 -rw-r--r-- nr-access.conf
#
# ============= suffix.pl ==============
if test -f 'suffix.pl' -a X"$1" != X"-c"; then
echo 'x - skipping suffix.pl (File already exists)'
else
echo 'x - extracting suffix.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'suffix.pl' &&
# suffix.pl
#
# $Id: suffix.pl,v 1.5 1993/11/06 13:41:30 aas Exp $
#
# Author: Gisle Aas, Norsk Regnesentral, Oslo
#
# This package enables the server to return different version of a
# document depending on the domain where the client is. We use this
# package for serving Norwegian sites with Norwegian replies while all
# other sites get replies in English.
#
# When activated this package reads the file "domain.suffix" where it
# expects to find a mapping from various domain names to suffixes that
# the files should have. For instance a domain.suffix file that looks
# like this:
#
# .nr.no nynorsk
# .no bokmaal
# .se swedish
#
# And an HTTP client that runs on nora.nr.no and asks for
# http:/gisle.html makes the server return the first that exist
# of the following documents:
#
# gisle.nynorsk.html
# gisle.bokmaal.html
# gisle.html
X
X
package suffix;
X
$configFile = "/local/www/etc/domain.suffix";
&parseConfig;
X
sub do {
X local($path,$query) = @_;
X # query is not used
X &do("index.html",$query) unless length $path;
X -d $path && &main'error('forbidden',
X "You are not allowed to read direcotries like \"$path\"");
X local($af, $port, $inetaddr) = unpack($main'sockaddr, $main'peeraddr);
X local($name) = &main'hostname($inetaddr);
X
X local($suffix) = &findSuffix($name);
X local($file) = &retrieve($path, $suffix);
X
X &main'error('internal_error', "This should not happen, $name!");
}
X
X
sub retrieve {
X local($p, $suf) = @_;
X local($s, $f);
X
X local($dir, $file);
X local($i) = rindex($p, '/');
X $dir = substr($p, 0, $i);
X $dir = "." unless length $dir;
X $file = substr($p, $i + 1);
X
X for $s (split(":", $suf)) {
X $f = $dir . "/" . &makeFilename($file, $s);
X if (-f $f) { &main'retrieve($f); exit }
X #print "Can't locate '$f'<p>\n";
X }
X &main'retrieve($path);
X exit;
}
X
sub makeFilename
{
X local($file, $ekstra) = @_;
X $file .= ".$ekstra" unless $file =~ s/\.([^.]+$)/.$ekstra.$1/;
X return $file;
}
X
sub parseConfig
{
X local($x, $y);
X open(C, $configFile) || return;
X while (<C>) {
X s/#.*//; # remove comments
X s/^\s+//;
X s/\s+$//;
X next if /^$/;
X ($x, $y) = split(" ", $_);
X $x =~ s/^\.//;
X $y =~ s/^\.//;
X $y =~ s/://g;
X $domSuffix{$x} = $y;
X #print "Domain $x prefeers suffix $y<p>\n";
X }
X close(C);
}
X
sub findSuffix
{
X local($n, $dom, $nn, $suffix);
X $nn = $_[0];
X
X $dom = "";
X for $n (reverse split(/\./, $nn)) {
X $dom = ".$dom" if length $dom;
X $dom = "$n$dom";
X if (defined $domSuffix{$dom}) {
X $suffix = ":$suffix" if length $suffix;
X $suffix = "$domSuffix{$dom}$suffix"
X }
X #print "$dom, $suffix<p>";
X }
X return $suffix;
}
1;
SHAR_EOF
chmod 0644 suffix.pl ||
echo 'restore of suffix.pl failed'
Wc_c="`wc -c < 'suffix.pl'`"
test 2702 -eq "$Wc_c" ||
echo 'suffix.pl: original size 2702, current size' "$Wc_c"
fi
# ============= sh.pl ==============
if test -f 'sh.pl' -a X"$1" != X"-c"; then
echo 'x - skipping sh.pl (File already exists)'
else
echo 'x - extracting sh.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'sh.pl' &&
# $Id: sh.pl,v 1.1 1993/11/06 13:27:10 aas Exp $
X
# This package is used for starting local applications by clicking on
# hypertext links. Just make a link to /sh/script or /sh?command and
# a document that is feed to the shell is returned. Put the following
# line in the .mailcap file:
#
# application/x-sh; sh -f %s
#
# Author: Gisle Aas, Norsk Regnesentral, Oslo
X
X
package sh;
X
sub do
{
X local($rest, $query) = @_;
X
X if (-f "sh/$rest") {
X &main'MIME_header('ok', 'application/x-sh');
X &main'raw_file("sh/$rest");
X return;
X }
X if ($rest eq "" && $query ne "") {
X &main'MIME_header('ok', 'application/x-sh');
X $query =~ s/\+/ /g;
X $query =~ s/%([\da-f][\da-f])/sprintf("%c",hex($1))/egi;
X print "$query\n";
X return;
X }
X &main'error('not_found', "No script found")
}
X
1;
SHAR_EOF
chmod 0644 sh.pl ||
echo 'restore of sh.pl failed'
Wc_c="`wc -c < 'sh.pl'`"
test 849 -eq "$Wc_c" ||
echo 'sh.pl: original size 849, current size' "$Wc_c"
fi
# ============= inc.pl ==============
if test -f 'inc.pl' -a X"$1" != X"-c"; then
echo 'x - skipping inc.pl (File already exists)'
else
echo 'x - extracting inc.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'inc.pl' &&
# inc.pl - inplements the <inc cmd="cmd"> tag for hacked-html text
#
# $Id: inc.pl,v 1.1 1993/11/06 13:36:11 aas Exp $
#
# Autor: Gisle Aas, Norsk Regnesentral, Oslo
X
package inc;
X
&init;
sub init
{
X $main'ext{'hacked-html'} = 'text/hacked-html';
X $main'trans{'text/hacked-html'} = "text/html:inc'html";
}
X
sub html
{
X # this is a translation filter
X while (<STDIN>) {
X s/<inc\s+([^>]*)>/&inc($1)/ige;
X print;
X }
}
X
sub inc
{
X local($_) = $_[0];
X return scalar(`$1`) if /^cmd="([^"]+)"/i;
X return "<pre>\n".scalar(`$1`)."</pre>\n" if /^precmd="([^"]+)"/i;
X return eval "$1" if /^perl="([^"]+)"/i;
X return scalar(`cat $1`) if /^file="([^"]+)"/i;
X return "<em><inc $1> not understood</em>";
}
1;
SHAR_EOF
chmod 0644 inc.pl ||
echo 'restore of inc.pl failed'
Wc_c="`wc -c < 'inc.pl'`"
test 795 -eq "$Wc_c" ||
echo 'inc.pl: original size 795, current size' "$Wc_c"
fi
# ============= nr-access.pl ==============
if test -f 'nr-access.pl' -a X"$1" != X"-c"; then
echo 'x - skipping nr-access.pl (File already exists)'
else
echo 'x - extracting nr-access.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'nr-access.pl' &&
#
# access-filter.pl -- Disallow access to certain paths
#
# access-filter.pl,v 1.3 1993/10/05 20:50:29 sanders Exp
#
# by Tony Sanders <sanders@bsdi.com>, Oct 1993
# extended (and renamed) by Gisle Aas <aas@nr.no>, Oct 1993
#
# Read a configuration file and disallow certain paths/domain combinations
# Requires configuration.
X
sub access {
X local($fromfd, $peeraddr, $action, $path, $version) = @_;
X local($af, $port, $inetaddr) = unpack($main'sockaddr, $peeraddr);
X local($host) = &main'hostname($inetaddr);
X
X local($line, $op, $path_pat, $domain_pat);
X foreach $line (@access_filter'lines) {
X ($op, $path_pat, $domain_pat) = split(' ', $line);
X if (($path =~ $path_pat) && ($host =~ $domain_pat)) {
X &main'error('forbidden', "$action $path invalid") if $op eq "DENY";
X last;
X }
X }
}
X
package access_filter;
X
&access_filter'config($main'plexus{'nr-access-config'});
X
sub config {
X &main'debug("config $_[0]");
X local($config) = shift || die "access-filter: no config file\n";
X local($path,$domain);
X @lines = ();
X &main'open("access_filter'CONFIG", $config) || die "$config: $!";
X while (<CONFIG>) {
X if (/^\s*(ALLOW|DENY)\s+\/?(\S+)\s*(\S*)/) {
X $path = &main'globpat($2);
X $domain = &main'globpat($3);
X push(@lines, "$1 $path $domain");
X }
X }
X close(CONFIG);
}
X
1;
SHAR_EOF
chmod 0644 nr-access.pl ||
echo 'restore of nr-access.pl failed'
Wc_c="`wc -c < 'nr-access.pl'`"
test 1374 -eq "$Wc_c" ||
echo 'nr-access.pl: original size 1374, current size' "$Wc_c"
fi
# ============= nr-access.conf ==============
if test -f 'nr-access.conf' -a X"$1" != X"-c"; then
echo 'x - skipping nr-access.conf (File already exists)'
else
echo 'x - extracting nr-access.conf (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'nr-access.conf' &&
# OP PATH DOMAIN
X
ALLOW /private* *.nr.no
DENY /private* *
X
DENY /hidden* *
X
ALLOW /op2* *.nr.no
DENY /op2* *
SHAR_EOF
chmod 0644 nr-access.conf ||
echo 'restore of nr-access.conf failed'
Wc_c="`wc -c < 'nr-access.conf'`"
test 114 -eq "$Wc_c" ||
echo 'nr-access.conf: original size 114, current size' "$Wc_c"
fi
exit 0