#!perl #----------------------------------------------------------------------------- # # Relocator # # Written: 2001/12/12 Dingus # Modified: 2002/07/26 Dingus # # Redirects you to another port on the same server. Either as a redirect 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 # # # # # Modification allows you to do redrects to remote servers too using # either relo.cgi?u=URI&m=C&t=TTT or # # # # 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?query ) # #----------------------------------------------------------------------------- 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 "

Script Error

running".$ENV{'SCRIPT_NAME'}."

";
    $msg =~ s/ (of )*\Q$0//g;
    print "$msg
Email me this page"; return unless ($ENV{'REMOTE_ADDR'} eq "127.0.0.1"); print '

Environment Variables:

';
    foreach (sort keys %ENV) {
	print "$_: [$ENV{$_}]\n";
	}
    print "
"; } 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 < $relo{'NAME'} <H1>Sorry!</H1> <H3>This page must be viewed by a browser that is capable of viewing frames.</H3> EOFRAME } else { print redirect($uri); }