The redirector: results

#!/usr/bin/perl -wT # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*- # WARNING # THIS SCRIPT IS VULNERABLE TO XSS ATTACKS # If you use this on your site, be careful not to have anything on # your entire domain that cares about being hit by an XSS attack. # redirector: The redirector # # Copyright (c) 2002 by Ian Hickson # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA use strict; use CGI; use HTML::Entities; use URI::Escape; # collect data from user my $query = CGI->new(); my $redirectURI = $query->path_info() || ''; # this has to be double escaped to work around an Apache bug -- Apache handles %2F ('/') incorrectly in paths. XXX my $displayURI = $query->param('uri') || ''; my $method = $query->request_method() || 'GET'; my $script = 'http://' . $ENV{SERVER_NAME} . ':' . $ENV{SERVER_PORT} . $ENV{'SCRIPT_NAME'}; $redirectURI =~ s|^/||os; $redirectURI = uri_unescape($redirectURI); # NOTE! This only unescapes it ONCE because Apache randomly unescapes it once for us! XXX if (lc $method eq 'get' and $redirectURI =~ m/^[-a-z0-9]+:/osi) { # Apache (at least the version this script was originally written # for) uses, it appears, an 8kb buffer when parsing headers # generated by scripts. # # This means that the longest URI that can be successfully sent # back using Location: headers is 8kb less the trailing CRLF less # the leading "Location: ", namely 8 * 1024 - 12 bytes. # # If it is longer than that, we'll just give the user a link. # Note that there are at least 4 different ways in which we # attempt to do the redirect, and a fifth for manual redirect if # the other 4 fail. This had better work in all browsers. my $resultEscaped = encode_entities($redirectURI); if (length($redirectURI) < 8 * 1024 - 12) { print "Status: 301 Permanent Redirect\nLocation: $redirectURI\n"; if (length($redirectURI) < 8 * 1024 - 17) { print "Refresh: 0;url=$redirectURI\n"; } } else { print "Status: 200 OK\n"; } print < The redirector: results

Please see: $resultEscaped

end } elsif (lc $method eq 'post' and $displayURI =~ m/^[-a-z0-9]+:/osi) { my $resultEscaped = encode_entities($script . '/' . uri_escape(uri_escape($displayURI))); print < The redirector: results

You want to use the following URI:

$resultEscaped

end } else { my $extra = ''; if ($displayURI ne '') { $displayURI = encode_entities($displayURI); $extra = 'The URI must be an absolute path with a scheme at the start.'; } $script = encode_entities($script); print < The redirector kitchen

If you have any problems, e-mail me.

end }