Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

The Ultimate Rediector CGI Script

by dingus (Friar)
on Nov 27, 2002 at 10:15 UTC ( #216045=sourcecode: print w/replies, xml ) Need Help??
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);
}
Replies are listed 'Best First'.
Re: The Ultimate Rediector CGI Script
by grantm (Parson) on Nov 27, 2002 at 11:35 UTC

    Instead of:

    <H3>This page must be viewed by a browser that is capable of viewing + frames.</H3>

    You could use:

    <H3>Your browser does not support frames. <a href="$uri">View page +directly</a>.</H3>
•Re: The Ultimate Rediector CGI Script
by merlyn (Sage) on Nov 27, 2002 at 12:35 UTC
      You're missing the big warning...

      Sorry. Since I use the script exclusively for internal temporary things its never really out of debugging. Well thats my excuse and I'm sticking to it :)

      Dingus


      Enter any 47-digit prime number to continue.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://216045]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2021-01-24 23:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?