#!/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 # # # # # ################### end license & copyright header ################### $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 ($url =~ /^(ht|f)tp:\/\//) { &frameprt; } else { &Error("Your URL should start with with http:// or ftp://\n"); } sub frameprt { print "Content-type: text/html\n\n"; print qq~ $name (via The Cauldron: A Pagan Forum) <h1 align=center>Framed Page</h1> <p>Please consider upgrading to a frames-compatible browser or <a href="$url">click here</a> to view the page without frames. ~; exit; } sub Error { my($ErrorText) = @_; print "Content-type: text/html\n\n"; print "Error: ".$ErrorText; exit; }