#!/usr/local/bin/taintperl -- -*-perl-*-
#
# RANDOM - Generate random URL from a text file 'database.'
# By Jason A. Dour
# 
# (c) 1995  Jason A. Dour & the University of Louisville
#
# Free for distribution, copying, editing, and hacking under the GNU public
# license.  See file 'gnu.public.license.2.0' for specific information.
# This software comes with no guarantees implicit or implied, and the 
# author(s) of this software cannot be held responsible for loss, damage, 
# acts of god(s), large amounts of small rodentia, deafness, plague, 
# baldness, or nose-bleeds occurring as a direct -- or indirect -- 
# result of the use of 'random.'  This software is to be used for 
# randomizin, peace, love, and spreading genuine feelings of well being.
# All other uses are denounced by the author(s).
#
# Love, Peace, Gerbils, & Hair Grease,
# Jason A. Dour
#
# Last modified on 08/14/97 by Erik C. Thauvin <erik@skytouch.com>
#
# To call random, use something like:
#
#    http://www.eskimo.com/cgi-bin/random/~yourlogin/filename
#
# where "filename" is a world readable file located in your public_html
# directory, and containing the listing of URLs.
#--------------------------------------------------------------------------
#
$ENV{'PATH'}="/bin:/usr/bin:/usr/lib";
$ENV{'IFS'} = "";
#
# Email address/name of contact for server problems.
#
$contact = "webmaster\@eskimo.com";
#
# HREF of the mail URL for the server contact.
#
$contact_url = "mailto:webmaster\@eskimo.com";
#
# Get the filename by reading the CGI env. variable.
#
&system_error("Incorrect CGI method!  Use GET for proper operation.")
    if ( $ENV{'REQUEST_METHOD'} eq "POST" );
&system_error("No list file provided!")
    if ( !$ENV{'PATH_TRANSLATED'} );
&system_error("List file does not exist!")
    if ( ! -e $ENV{'PATH_TRANSLATED'} );
&system_error("List file cannot be accessed!")
# if ( ! -r $ENV{'PATH_TRANSLATED'} or ! -R $ENV{'PATH_TRANSLATED'} );
# Changed "or" to "||" -- ECT 04/19/95
    if ( ! -r $ENV{'PATH_TRANSLATED'} || ! -R $ENV{'PATH_TRANSLATED'} );
&system_error("List file has nothing in it!")
    if ( -z $ENV{'PATH_TRANSLATED'} );
#
# Open the file and read in all of its contents.  So far, this has been
# effective on files up to 1 Meg in size.  Anything larger, I am not certain.
#
open(LIST_FILE,$ENV{'PATH_TRANSLATED'}) || &system_error("File cannot be opened!");
read(LIST_FILE,$list_buffer,(-s $ENV{'PATH_TRANSLATED'}));
close(LIST_FILE);
#
# Split the URL list.
#
@urls = split(/\n/,$list_buffer);
#
# Get a random array number; the random seed being based upon time, and
# current and parent process id's.
#
srand( (time/$$)*getppid );
$location = int(rand($#urls+1));
#
# Print out the random location if it is a valid URL.
#
if ( grep (/^http/,$urls[$location]) || grep (/^file/,$urls[$location]) ||
     grep (/^ftp/,$urls[$location]) || grep (/^gopher/,$urls[$location]) ||
     grep (/^news/,$urls[$location]) || grep (/^telnet/,$urls[$location]) ||
     grep (/^tn3270/,$urls[$location]) || grep (/^mailto/,$urls[$location]) ||
     grep (/^nntp/,$urls[$location]) || grep (/^wais/,$urls[$location]) ||
     grep (/^prospero/,$urls[$location]) )
    {
        print "Location: $urls[$location]\n\n";
        exit(0);
    }
    else
    {
        $error = $location+1;
# &system_error("Invalid URL:<DD>$urls[$location]<BR>at line $error of $ENV{'PATH_TRANSLATED'}.  Please let the maintainer of this file know this error occurred.");
# Changed to match standard CERN error format -- ECT 04/25/95
        $urlval = $urls[$location];
        $urlval =~ s/\&/\&amp\;/g;
        $urlval =~ s/\</\&lt\;/g;
        $urlval =~ s/\>/\&gt\;/g;
        &system_error("Invalid URL -- <code>$urlval</code> at line <b>$error</b> of <code>$ENV{'PATH_TRANSLATED'}</code>. Please let the maintainer of this file know this error occurred.");
    };
#
# Generic system error page.  Will print out whatever error text you provide.
#
sub system_error
{
    print "Content-type: text/html\n\n";
# print "<title>RANDOM: ERROR!</title>";
# print "<H1><center>ERROR!</center></H1><hr size=3 width=50% align=middle>";
# print "<H3>The error encountered was:<BR><DD>$_[0]<BR>";
# print "If you feel that this error is server related, contact ";
# print "<a href=$contact_url>";
# print "$contact</a>.</H3>";
# print "<HR size=3><H4>RANDOM URL SELECTOR - March 8th, 1995<BR>";
# print "&copy 1995 Jason A. Dour & the University of Louisville<BR>";
# print "Send comments, questions, suggestions, or problems to <I>$contact</I>.<BR>";
# Changed to standard CERN error format -- ECT 04/19/95
    print "<html>\n";
    print "<head>\n";
    print "<title>Error</title>\n";
    print "</head>\n";
    print "<body>\n";
    print "<h1>Error</h1>\n";
    print "$_[0]\n";
    print "<p>\n";
    print "If you feel this error is server related, please contact <a href=$contact_url>$contact</a>.\n";
    print "<p>\n";
    print "<hr>\n";
    print "<address><a href=\"http://mothersoft.org/\">RANDOM</a> &copy 1995 Jason A. Dour & the University of Louisville.</address>\n";
    print "</body>\n";
    print "</html>\n";
    exit(0);
}