#!/usr/local/bin/perl 
# Change the previous line to refect the location of perl on your system
#
# redirect -- PERL redirection script
#
# Kelly Yancey <kbyanc@freedomnet.com>,  5/23/97, 4/2/98
# Carlos A. Pero <cpero@ncsa.uiuc.edu>, 10/22/95
#
# For usage information, request the script's URL through the Web
# without submitting any data by typing the URL directly into
# your browser's address field.
#

$ENV{'SCRIPT_NAME'} =~ m#(/.*/)(.*)$#;
$SCRIPTDIR = $1;
$SCRIPT = $2;

#### Do standard HTTP stuff ####
&cgi_receive;
&cgi_decode;

# Adapted by Steffen Christensen from source code provided to the internet
# community by Kelly Yancey, modified from an earlier version provided by
# Carlos A. Pero, distributed with NCSA httpd. 
# As viewed from http://www.posi.net/software/selectpage/, on 18 March 2002.

# added by Kelly Yancey, 1997, 1998...
# this is a lot of code just to allow relative URL's to be used...and it still isn't foolproof.
# the problem is that redirection requires the full URL with most servers. The best we can try to
# do is look at the referer's URL (usually specified in the HTTP_REFERER environment variable) and
# from determine the new URL relative to that. The problem comes in when the HTML document has a
# <BASEREF> tag indicating a path other than the one to the HTML document is to be used to fetch
# other documents...there only way for a CGI to compensate for that is to fetch the HTML document
# itself, parse it looking for a <BASEREF> tag, and then figure out the full URL of the destination
# accordingly...that is a lot of work for a simple CGI. Already, relative URLs are a lot of work
# for an otherwise simple CGI. In other words, it is best to use full URLs, but if you can't we
# will *try* to deal with it as best as possible.
if ($FORM{'url'}) {
    $_=$FORM{'url'};
    if ((! /:\/\//) && ($refer=$ENV{'HTTP_REFERER'})){	# does the url contain :// in it, if not then we need to 
						# try to guess what the full URL is supposed to be since
						# the client requires full URLs for redirection...
						# we cannot guess without the HTTP_REFERER variable
	if(substr($FORM{'url'},0,1) eq "/") {	# check if the first character is a slash
	    $_ = $refer;
	    /(.*:\/\/[A-Za-z0-9.-]*\/)/;	# match protocol and host part of the referrer URL (matches domain name portion by use of the fact that only letters, numbers, dots, and dashes can be part of the domain name)
            $temp=$1; chop($temp); $temp .= $FORM{'url'};	# tack the absolute URL onto the missing protocol and host info
	    $FORM{'url'}=$temp;			# replace the original url with the new full url
	}
	else {					# if the url does not start with a slash, then we have the fun job
						# of trying to figure out where the new url is in relation to the referer's url
	    $temp = $refer;			# we are going to make the new path relative to the referer
	    do { $letter=chop($temp); } until $letter eq "/";	# remove any filename info from the full URL
            @PARTDIR = split(/\//, $FORM{'url'});# first, we get all the directory components of the new url
            foreach $dir (@PARTDIR) {       	# we will parse each directory component of the url one at a time
                next if(($dir eq ".")||($dir eq "")); # the . directory doesn't change anything
                if($dir eq "..") {          	# the .. directory tells us to strip the last directory off the last directory component of the URL
                    do { $letter=chop($temp); } until $letter eq "/";
            	}
		else {				# otherwise, this is new info to be tacked onto the URL
		    $temp .= "/"; $temp .= $dir;# tack a delimiting slash and the new info onto the URL
		}
	    }
	    $FORM{'url'}=$temp;			# now that we are done, put the trailing slash back on and store the full url back into the correct variable
	}
    }
}
else {						# if no redirection URL is given, then return client to referring page
						# if there is no referring page, then url will remain blank and therefor the
						# help screen will be displayed
    $FORM{'url'} = $ENV{'HTTP_REFERER'};
}

#### Output instructions if not receiving a URL ####
&print_info unless $FORM{'url'};

#### Output redirection ####
# <META HTTP_EQUIV...> line added by Kelly Yancey, 1997...
print <<"EndResponse";
Status: 302 Redirected
Content-type: text/html
Location: $FORM{'url'}

<HTML><HEAD>
<TITLE>Client Redirected</TITLE>
<META HTTP-EQUIV="Refresh" CONTENT="1; URL=$FORM{'url'}">
</HEAD><BODY>
The CGI script has redirected your browser to <A HREF="$FORM{'url'}">this location</A>.
</BODY></HTML>
EndResponse
exit;

#####################################################################
#### SUBROUTINES ####################################################

sub cgi_receive {
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'});
    }
    else {
        $incoming = $ENV{'QUERY_STRING'};
    }
}

sub cgi_decode {
    @pairs = split(/&/, $incoming);

    foreach (@pairs) {
        ($name, $value) = split(/=/, $_);

        $name  =~ tr/+/ /;
        $value =~ tr/+/ /;
        $name  =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
        $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;

        #### Strip out semicolons unless for special character
        $value =~ s/;/$$/g;
        $value =~ s/&(\S{1,6})$$/&\1;/g;
        $value =~ s/$$/ /g;

        $value =~ s/\|/ /g;
        $value =~ s/^!/ /g; ## Allow exclamation points in sentences

        #### Skip generally blank fields
        next if ($value eq "");

	#### Allow for multiple values of a single name
        $FORM{$name} .= ", " if ($FORM{$name});

	#### Check to see if input NAME is the URL, i.e. SUBMIT button
	if ($name =~ m|^\w+:\S+$|) { $FORM{'url'} = $name; }

        $FORM{$name} .= $value;
    }
}

sub print_info {
    print <<"EndHelp";
Content-type: text/plain

This redirect script will accept input from a FORM, either via
METHOD GET or POST, and send a 300-level HTTP status code to
redirect the browser to a new URL.

There are two ways to use a FORM in conjunction with this script:

1.  A list of URLs with a submit button
       <FORM METHOD="POST" ACTION="/cgi-bin/redirect">
       <SELECT NAME="url">
       <OPTION VALUE="http://www.posi.net/">Posi.Net homepage
       <OPTION VALUE="http://hoohoo.ncsa.uiuc.edu/">NCSA HTTPd homepage
       <OPTION VALUE="http://www.uiuc.edu/">U of I
       </SELECT>
       <INPUT TYPE="submit" VALUE="Go to URL">
       </FORM>
    In this case, the script will find the input called "url" and
    redirect the browser to this location. The SELECT field must
    be named "url".

2.  Multiple submit buttons
       <FORM METHOD="POST" ACTION="/cgi-bin/redirect">
       <INPUT TYPE="submit" NAME="http://www.posi.net/" VALUE="Posi.Net homepage">
       <INPUT TYPE="submit" NAME="http://hoohoo.ncsa.uiuc.edu/" VALUE="NCSA HTTPd homepage">
       <INPUT TYPE="submit" NAME="http://www.ncsa.uiuc.edu/" VALUE="U of I">
       </FORM>
    In this case, the script will find an input NAME that looks like a URL,
    and redirect the browser to this location.

Either method should work fine, just don't use both within the same FORM.

Absolute URLs are highly recommended (ie. http://somewhere.com/file.html), however if you
positively *need* to use relative URLs (ie. /file2.html) this redirect CGI attempts to
automatically build a full URL based on the URL of the refering page. For example, if your
web page at http://www.posi.net/software/public/index.html had a form which redirected
the user to the relative URL "info.html", the redirect CGI would redirect the user to
the new web page http://www.posi.net/software/public/info.html (it grabbed the missing
URL information for the referring URL). This is by all means not foolproof, but it does
function correctly in most circumstances.

EndHelp
    exit;
}

