#!/usr/bin/perl
######################################################################
# Redirect URL                            Version 1.0                #
# Copyright 1999 Frederic TYNDIUK (FTLS)  All Rights Reserved.       #
# E-Mail: tyndiuk@ftls.org                Script License: GPL        #
# Created  05/30/99                       Last Modified 05/30/99     #
# Scripts Archive at:                     http://www.ftls.org/cgi/   #
######################################################################
# Function :                                                         #
# Redirect visitor to another URL                                    #
# Use it : redirect.cgi?URL                                          #
# URL = http://www.webdom.com/page/                                  #
######################################################################
##################### license & copyright header #####################
#                                                                    #
#                 Copyright (c) 1999 TYNDIUK Frederic                #
#                                                                    #
#  This program is free software; you can redistribute it and/or     #
#  modify it under the terms of the GNU General Public License as    #
#  published by the Free Software Foundation; either version 2 of    #
#  the License, or (at your option) any later version.               #
#                                                                    #
#  This program is distributed in the hope that it will be useful,   #
#  but WITHOUT ANY WARRANTY; without even the implied warranty of    #
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the     #
#  GNU General Public License for more details.                      #
#                                                                    #
#  You should have received a copy of the GNU General Public License #
#  along with this program in the file 'COPYING'; if not, write to   #
#  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,  #
#  Boston, MA 02111-1307, USA, or contact the author:                #
#                                                                    #
#                              TYNDIUK Frederic <tyndiuk@ftls.org>   #
#                                       <http://www.ftls.org/>       #
#                                                                    #
################### end license & copyright header ###################
######################################################################
# Necessary Variables:                                               #
# The following variables should be set to define the locations      #
# and URLs of various files, as explained in the documentation.      #

#Options:
$UseLog = 0;      # Use Log File ? 1 = YES; 0 = NO
$LogFile = "/Absolute/path/to/log.txt";

# Nothing Below this line needs to be altered!                       #
######################################################################

	@date = localtime(time); $date[4]++;
	$Time = "$date[4]/$date[3]/$date[5]";

	$Query_File = $ENV{QUERY_STRING};
	$Query_File =~ s/%([0-9A-F][0-9A-F])/pack("C",oct("0x$1"))/ge;
	$Query_File =~ tr/+/ /;
	($url) =  split(/\&/,$Query_File);

	if ($url =~ /=/) {
		($name, $url) = split(/=/, $url);
	}

	if ($UseLog) {
		open(LOG,">>$LogFile") || &Error("Cannot Write Log File : $LogFile, Error $!\n");
		print LOG "[$Time] - $ENV{'REMOTE_HOST'} -> $url\n";
		close(LOG);
	}

	if ($url =~ /^(ht|f)tp:\/\//) {
		print "Location: $url\n\n";
	} else {
		&Error("Your URL sould be begining by http:// or ftp://\n");
	}

sub Error {
	my($ErrorText) = @_;
	print "Content-type: text/html\n\n";	
	print "Error: ".$ErrorText;
	exit;
}