#!/usr/bin/perl

#-------------------------Welcome-----------------------------
#
# ClickGo 
# Ver. 1.1.2
# By Luke and Mark Pfeifer
# http://www.staff.net/cgi-scripts/		
# Released 5-7-97
# Updated  12-30-97
#
# Copyright Info: This application was written by Mark and Luke
# Pfeifer. Feel free to copy, cite, reference, sample, borrow 
# or plagiarize the contents.  However, if you don't mind,
# please let us know where it goes so that we can watch and take
# part in the development of it. Information wants to be free,
# support public domain freeware.  Donations are appreciated
# and will be spent on further upgrades and other public domain
# scripts.
#
# Finally, PLEASE SEND WORKING URL's to scripts@staff.net.
# We would like to keep a list of these scripts in use.
#-------------------------------------------------------------

#-----------------------Version History--------------------------
#
# Version 1.0	- 5-7-97	- Orginal Version Created
#
# Version 1.1	- 7-19-97	- Now works with IIS (Internet
#				  Infromation Server) and PWS
#				  (Personal Web Server)
#				- Allows linking via protocols
#				  other than HTTP, like FTP
#
# Version 1.1.1	- 7-29-97	- Better way to handle IIS
#				- Do not need $iis configuration
#				  variable any more
#
#
# Version 1.1.2	- 12-30-97	- Fixed header for Unix Scripts
#							- Fixed syntax error with older
#								versions of Perl
#
#-------------------------------------------------------------

#-----------------------ReadMe--------------------------------
#
# This script now works with IIS (Internet Infromation Server)
# and PWS (Personal Web Server)!  And also with Unix Servers!
#
# This script requires that PERL is loaded on your web server
# and that the web server is configured to run PERL scripts as
# CGI scripts.
#
# Configure the script in the User Configuration section below.
#
# Upload this file to your CGI directory on your web server in
# ASCII mode.  If you do not know if you have a CGI directory,
# ask your web server administrator.
#
# Chmod this file to 755, if you have Unix.
#
# The script is called by creating a link like this
#    <form method="post" action="http://www.yourserver.com/cgi-bin/clickgo.pl"> 
#		<select name="goto" size="1">
#               <option value="www.railserve.com">RailServe</option>
#               <option value="www.staff.net">Staff.Net</option>
#		</select>
#		<input type="submit" value="GO!">
#	</form>
#
#   Notes on above example:
#
#	- You need to change the action of the form to use the
#	  clickgo.pl script that you uploaded to your server
#
# 	- The option values that are used in the HTML form can
#	  contain the protocol name (i.e. http://, ftp://, etc).
#	  If they do not, the HTTP protocol will be assumed.
#
#-------------------------------------------------------------
#
#--------------- Variable Definition --------------------------
#
# $main - the url of the default page to go to if there is no
#         url specified when the script is executed
#
#-------------------------------------------------------------

#------- Start User Configuration ----------------------------
$main = 'http://www.staff.net/cgi-scripts/index.html';
#---End User Configuration -----------------------------------

#**************** DO NOT EDIT PAST THIS LINE *****************#

&FormInput(*input);

if($input{'goto'} eq "")
{
	print "HTTP/1.0 302 Temporary Redirection\r\n" if $ENV{PERLXS} eq "PerlIS";
	print "Content-type: text/html\n";
	print ("Location: $main\n\n");
}
else
{
	if ($input{'goto'} !~ m?://?)
	{
		$input{'goto'} = "http://" . $input{'goto'};
	}
	print "HTTP/1.0 302 Temporary Redirection\r\n" if $ENV{PERLXS} eq "PerlIS";
	print "Content-type: text/html\n";
	print ("Location: $input{'goto'}\n\n");
}

exit;
#-------------------------------------------------------------
# FormInput: Function
#-------------------------------------------------------------
sub FormInput
{
local (*qs) = @_ if @_;

if ($ENV{'REQUEST_METHOD'} eq "GET")
{
	$qs = $ENV{'QUERY_STRING'};
}
elsif ($ENV{'REQUEST_METHOD'} eq "POST")
{
	read(STDIN,$qs,$ENV{'CONTENT_LENGTH'});
}

@qs = split(/&/,$qs);

foreach $i (0 .. $#qs)
{
	$qs[$i] =~ s/\+/ /g;
	$qs[$i] =~ s/%(..)/pack("c",hex($1))/ge;

	($name,$value) = split(/=/,$qs[$i],2);

	if($qs{$name} ne "")
	{
		$qs{$name} = "$qs{$name}:$value";
	}
	else
	{
		$qs{$name} = $value;
	}
}

return 1;
}