#!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);
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|