http://qs321.pair.com?node_id=216045
Category: CGI Programming
Author/Contact Info Dingus (Dingus.at.zaphodb.org)
Description: Redirects the browser to different places.

You can use this to redirect to servers running on other ports of the same computer or to any specified URI.

You can either show the redirected location or you can hide it in a FRAME which has the title of your choice and the location of the script.

XML files should go somewhere in your webpages diretory tree (i.e. anywhere below $ENV{"DOCUMENT_ROOT"} ) and you get redirected nicely using the url:
http://yourserver/cgi-bin/relo.cgi/path/file
the file name itself is $ENV{"DOCUMENT_ROOT"}/path/file.xml.

Note that if you use the Frame method to a URI which isn't yours, you are guilty of deception if not copyright violation.

 
#!perl
#---------------------------------------------------------------------
+--------
#
#  Relocator
#
#  Written:  2001/12/12  Dingus
#  Modified: 2002/07/26  Dingus
#
#  Redirects you to another port on the same server. Either as a redir
+ect or
#  as an embedded frame. You can call it in 2 ways: either call direct
+ 
#    relo.cgi?p=PPP&m=C&t=TTT
#    where PPP is the port for the redirect
#    C is either an R for redirect or an F for frame
#    TTT is a title used to give the frame mode a title. It is ignored
+ in R mode
#  or use as the script for a service.xml script
#    e.g. a SWAT service redirector would look like
#    <RELO>
#      <SERVICE NAME='Swat' PORT='901' MODE='FRAME'/>
#    </RELO>
#
#  Modification allows you to do redrects to remote servers too using 
#  either relo.cgi?u=URI&m=C&t=TTT or 
#    <RELO>
#      <SERVICE NAME='Remote Server' MODE='FRAME'
#        URI='http://remote.example.com/path/to/somewhere.html' />
#    </RELO>
#  Note that the direct call method will not cope well with URIs that 
+have 
#  their own query strings (i.e. URIs of the form http://some/where?qu
+ery )
#
#---------------------------------------------------------------------
+--------

use CGI::Carp qw(fatalsToBrowser set_message);
use CGI qw(:standard);
use XML::Simple;

# --------------------------------------------------------------------
+---------
# standard error handlng stuff.
# --------------------------------------------------------------------
+---------

BEGIN {
  sub handle_errors {
    my $msg = shift;
    print "<h1>Script Error</h1> running".$ENV{'SCRIPT_NAME'}."<p><pre
+>";
    $msg =~ s/ (of )*\Q$0//g;
    print "$msg</pre><A HREF='mailto:myemail@ddress'>Email me this pag
+e</a>";
    return unless ($ENV{'REMOTE_ADDR'} eq "127.0.0.1");
    print '<p><B>Environment Variables:</B><PRE>';
    foreach (sort keys %ENV) {
    print "$_: [$ENV{$_}]\n";
    }
    print "</pre></BODY></HTML>";
    }
  set_message(\&handle_errors);
}

# --------------------------------------------------------------------
+---------
# Do the redirect / frame
# --------------------------------------------------------------------
+---------

my %relo = ('MODE'=>'REDIRECT', PORT=>'8080');
if (path_info()) {
    $fn = $ENV{'DOCUMENT_ROOT'}.path_info().'.xml';
    die "Can't use ".path_info() unless -e($fn);
    $xml = XMLin($fn);
    %relo = (%relo, %{$$xml{'SERVICE'}});
}
else {
    my %conv = ( 'u'=>'URI', 'm'=>'MODE', 'p'=>'PORT', 'n'=>'NAME' );
    for (url_param()) {
    $relo{$conv{$_}} = url_param($_) if (exists $conv{$_});
    }
}
$uri = ($relo{'URI'} or 'http://'.$ENV{'HTTP_HOST'}.":$relo{'PORT'}/")
+;
if (uc(substr($relo{'MODE'},0,1)) eq 'F') {
    $relo{'NAME'} = "Relo to $uri" unless ($relo{'NAME'});
    print <<EOFRAME ;
<HTML><HEAD>
<TITLE>$relo{'NAME'}</TITLE></HEAD>
<FRAMESET cols='*'>
  <FRAME name="In" src='$uri'>
  <NOFRAMES>
  <H1>Sorry!</H1>
  <H3>This page must be viewed by a browser that is capable of viewing
+ frames.</H3>
  </NOFRAMES>
</FRAMESET></HTML>
EOFRAME
}
else {
    print redirect($uri);
}

Back to Code Catacombs