#!/usr/bin/perl

# Copyright 1994 David C. Kaplowitz  All Rights Reserved
# Permission is given to freely distribute and modify this product so long
# as it is done without charge and so long as this Copyright text remains in
# place.
# Certain designs inherent may be copyrighted elsewhere.
# David C. Kaplowitz 1994
#
# This perl script does three fairly different things.  First
# if it is invoked with the environment variable PATH_INFO set
# to "display" it prints itself.  Second if it is called with a GET type
# HTML form, it will return the results from the information submitted to
# the program.  Third, if called with no arguments at all, it will return
# it's own front end.

$gn_arg = $ENV{PATH_INFO};  # Get the argument from the URL
$gn_script = $ENV{SCRIPT_NAME};
$gn_script =~ s/cgi-bin/WWW\/root2\/cgi-bin/;
if ($gn_script =~ /\/~(\w+)\/(.*)/) {
   open (PASSWD, '/etc/passwd');
   while (<PASSWD>) {
      ($login, $passwd, $uid, $gid, $gcos, $home, $shell) = split(/:/);
      if ($1 eq $login) {$gn_script = "$home/public_html/$2";}
    }
   close (PASSWD);
 }

# Display this file.
#  The print and $| = 1 are needed to flush buffer.
if ( $gn_arg =~ /display/) {
   print "Content-type: text/plain\n\n";
   $| = 1;
   print "Here is the script:\n";  
   exec "/bin/cat $gn_script";
 }
 else {
   print "Content-type: text/html\n\n";
   srand;

   @adj1 = ("artless", "bawdy", "beslubbering", "bootless", "churlish",
            "cockered", "clouted", "craven", "currish", "dankish",
            "dissembling", "droning", "errant", "fawning", "fobbing",
            "froward", "frothy", "gleeking", "goatish", "gorbellied",
            "impertinent", "infectious", "jarring", "loggerheaded",
            "lumpish", "mammering", "mangled", "mewling", "paunchy",
            "pribbling", "puking", "puny", "quailing", "rank", "reeky",
            "roguish", "ruttish", "saucy", "spleeny", "spongy", "surly",
            "tottering", "unmuzzled", "vain", "venomed", "villainous",
            "warped", "wayward", "weedy", "yeasty");

   @adj2 = ("base-court", "bat-fowling", "beef-witted", "beetle-headed",
            "boil-brained", "clapper-clawed", "clay-brained",
            "common-kissing", "crook-pated", "dismal-dreaming",
            "dizzy-eyed", "doghearted", "dread-bolted", "earth-vexing",
            "elf-skinned", "fat-kidneyed", "fen-sucked", "flap-mouthed",
            "fly-bitten", "folly-fallen", "fool-born", "full-gorged",
            "guts-griping", "half-faced", "hasty-witted", "hedge-born",
            "hell-hated", "idle-headed", "ill-breeding", "ill-nurtured",
            "knotty-pated", "milk-livered", "motley-minded",
            "onion-eyed", "plume-plucked", "pottle-deep", "pox-marked",
            "reeling-ripe", "rough-hewn", "rude-growing", "rump-fed",
            "shard-borne", "sheep-biting", "spur-galled", "swag-bellied",
            "tardy-gaited", "tickle-brained", "toad-spotted",
            "unchin-snouted", "weather-bitten");

   @noun = ("apple-john", "baggage", "barnacle", "bladder", "boar-pig",
            "bugbear", "bum-bailey", "canker-blossom", "clack-dish",
            "clotpole", "coxcomb", "codpiece", "death-token", "dewberry",
            "flap-dragon", "flax-wench", "flirt-gill", "foot-licker",
            "fustilarian", "giglet", "gudgeon", "haggard", "harpy",
            "hedge-pig", "horn-beast", "hugger-mugger", "jolthead",
            "lewdster", "lout", "maggot-pie", "malt-worm", "mammet",
            "measle", "minnow", "miscreant", "moldwarp", "mumble-news",
            "nut-hook", "pigeon-egg", "pignut", "puttock", "pumpion",
            "ratsbane", "scut", "skainsmate", "strumpet", "varlot",
            "vassal", "whey-face", "wagtail");

   print "<TITLE>You ", &insult, "</TITLE>\n";
   print "I told you not to click here, you ", &insult, "!\n";

   sub insult {
      return("$adj1[rand @adj1] $adj2[rand @adj2] $noun[rand @noun]");
    } 
 }