The Ultimate Rediector CGI Script

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); }

Comment on The Ultimate Rediector CGI Script Download Code

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>` [download] You could use: `<H3>Your browser does not support frames. <a href="$uri">View page +directly</a>.</H3>` [download]	[reply] [d/l] [select]
•Re: The Ultimate Rediector CGI Script by merlyn (Sage) on Nov 27, 2002 at 12:35 UTC
You're missing the big warning: fatalsToBrowser should be used only while debugging, and not remain in production code. {sigh} -- Randal L. Schwartz, Perl hacker Be sure to read my standard disclaimer if this is a reply.	[reply]
Re: •Re: The Ultimate Rediector CGI Script by dingus (Friar) on Nov 27, 2002 at 13:02 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.`	[reply]


There's more than one way to do things
	PerlMonks