#!/usr/ucb/perl5
#
#	randimg
#
#	Generate a random image on a system with or without SSI.
#
#	Usage:
#	    If you have SSI (preferably w/ XBitHack), then you can simply
#	    put the following into your HTML:
#		<img src=
#		<!--#set var="dir" value="DIRECTORY" -->
#		<!--#exec cgi="cgi-bin/randimg" -->
#		>
#	    The DIRECTORY is either an actual directory, or the name
#	    of a file which contains a list of filenames, one per
#	    line.  The DIRECTORY name as well as any filenames listed
#	    in the specified file are in Web space.  I.e. files starting
#	    with "/" are in the htdocs directory, and those starting with
#	    "/~user" or "~user" are relative to the user's public_html
#	    directory.
#
#	Dave Regan
#	regan@ao.com
#	5 January 1997
#	This program is specifically placed in the Public Domain.
#	Do what you want with it.
#
#	Pick up http://www.peak.org/~regan/randimg.html for some instructions
#	on how to use this program.
#

###
###	Main program
###

    srand(time ^ $$ ^ $ENV{'REMOTE_PORT'});
#   HTMLhead("Random Image Generation");
    print "Content-type: text/html\n\n";
    $| = 1;
    if ($ENV{'dir'} ne "")
    	{
    	ProcessAsSSI($ENV{'dir'});
    	}
    else
    	{
    	ProcessWoSSI(GetFname($ENV{'QUERY_STRING'}));
    	}
    exit 0;


###
###	FileSpace
###
###	Translate a filename in web space into a filespace name.
###
sub FileSpace
    {
    local($dir) = @_;
    local($retval);

    if ($dir =~ m#^/*~([^/]+)(/.*)#)
    	{
    	$dir = $2;
    	$retval = (getpwnam($1))[7] . "/public_html";
    	$retval .= "/$dir";
    	}
    elsif ($dir =~ m#^/#)
    	{
    	# An "absolute" name
    	$retval = "$ENV{'DOCUMENT_ROOT'}/$dir";
    	}
    else
    	{
    	# A "relative" name
    	# Take the SCRIPT_FILENAME, remove the actual file name, and then
    	# add the name specified.
    	$retval = $ENV{'SCRIPT_FILENAME'};
    	$retval =~ s#/[^/]+$#/$dir#;
    	}
    $retval =~ s#//#/#g;
    return $retval;
    }


###
###	GetFname
###
###	Get a filename.  The filename is in web format.
###	Remove any leading .. stuff.
###
sub GetFname
    {
    local($webname) = @_;
    local($root, $user);

    $webname =~ s#\.\./##g;
    $root = $ENV{'DOCUMENT_ROOT'};
    if ($webname =~ m#^/*~(\w+)/(.*)#)
    	{
    	$webname = $2;
    	$user = $1;
    	$root = (getpwnam($user))[7] . "/public_html";
    	}
    return "$root/$webname";
    }


###
###	HTMLhead
###
###	Put out a HTML header
###
sub HTMLhead
    {
    local($title) = @_;

    print "Content-type: text/html\n\n";
    print "<html><head><title>$title</title></head>\n";
    print "<body>\n";
    }


###
###	HTMLterm
###
###	Put out the end of an HTML body.
###
sub HTMLterm
    {
    print "</body></html>\n";
    }


###
###     printenv
###
###     Display the environment.
###	This assumes that we can write on stdout.  This may not
###	be true if we haven't written the header line yet.
###
sub printenv
    {
    local($var);

    for $var (sort(keys %ENV))
        {
        print "$var=$ENV{$var}<br>\n";
        }
    }


###
###	ProcessAsSSI
###
###	Deal with the named directory.
###
sub ProcessAsSSI
    {
    local($dir) = @_;

    $dir = FileSpace($dir);
    ProcessFile($dir);
    }


###
###	ProcessFile
###
###	A file or directory name is passed.  If it is a directory
###	name look for any *.gif, *.jpg, or *.jpeg files (ignoring
###	case).  Choose one of them.
###
###	If it is a file, open it up and pick a random file from it.
###
sub ProcessFile
    {
    local($fname) = @_;
    local($file, @files);

    if (-d $fname)
    	{
    	opendir(DIR, $fname);
    	while ($file = readdir(DIR))
    	    {
    	    push(@files, "$fname/$file") if ($file =~ /\.gif$/i);
    	    push(@files, "$fname/$file") if ($file =~ /\.jpg$/i);
    	    push(@files, "$fname/$file") if ($file =~ /\.jpeg$/i);
    	    }
    	closedir(DIR);
    	}
    else
    	{
    	open(DIR, $fname);
    	while (<DIR>)
    	    {
    	    chomp;
    	    push(@files, $_);
    	    }
    	close DIR;
    	}
    print WebSpace($files[int(rand($#files + 1))]);
    }


###
###	ProcessWoSSI
###
###	There is no SSI.  So we have to process the file in its
###	entirety.
###
###	The target file is written in the same fashion as normal.
###	However, the link to the file must be as follows:
###		<a href="cgi-bin/randimg?/test4.html">text</a>
###
sub ProcessWoSSI
    {
    local($fname) = @_;
    local($dir);

#   print "File name is $fname<p>\n";
#   printenv();
    if (!open(DATA, "<$fname"))
    	{
    	HTMLhead("Bad file");
    	print "Cannot open $fname\n";
    	exit 0;
    	}
    while (<DATA>)
    	{
    	if (/<!--#set\s+var="dir"\s+value="([^"]*)"/)
    	    {
    	    $dir = FileSpace($1);
    	    }
	elsif (/<!--#exec cgi="cgi-bin\/randimg"/)
	    {
	    ProcessFile($dir);
	    }
	else
	    {
	    print $_;
	    }
    	}
    close DATA;
    }


###
###	WebSpace
###
###	Given an absolute filename, convert it to a filename in webspace.
###
sub WebSpace
    {
    local($fname) = @_;

    if (substr($fname, 0, length($ENV{'DOCUMENT_ROOT'})) eq
    				$ENV{'DOCUMENT_ROOT'})
	{
	return substr($fname, length$ENV{'DOCUMENT_ROOT'});
	}
    elsif ($fname =~ m#/([^/]+)/public_html/(.*)#)
    	{
    	return "/~$1/$2";
    	}
    return "/$fname";
    }
