#! /usr/bin/perl # CGI script for a 303-redirect service. # # Author: David Booth http://dbooth.org/2005/dbooth/ # Date: 5-Jun-2008 Updated: 8-May-2009 # License: Creative Commons GNU GPL: # http://creativecommons.org/licenses/GPL/2.0/ use strict; ######### Debug ######### my $debug = 0; print "Status: 200 OK\nContent-type: text/plain\n\n" if $debug; print "QUERY_STRING: " . $ENV{'QUERY_STRING'} . "\n" if $debug; print "REQUEST_URI: " . $ENV{'REQUEST_URI'} . "\n" if $debug; print "Program name: $0\n" if $debug; ######### Error Check ######### if (&IsRedirectLoop($ENV{'REQUEST_URI'})) { print &RedirectLoopResponse; exit 0; } ######### Redirect ######### # Do not use $ENV{'QUERY_STRING'} because it has already # been unescaped by apache: # my $reqUri = $ENV{'QUERY_STRING'}; my $reqUri = $ENV{'REQUEST_URI'}; $reqUri =~ s/\A(\/?)\?//; print "Status: 303 See Other\n"; print "Content-type: text/plain\n"; print "Location: $reqUri\n\n"; print "Redirecting to: $reqUri\n"; exit 0; ######### IsRedirectLoop ######### # Ensure that this program was not requested directly in the URI, # because doing so will cause a redirect loop if not intercepted. # To check, we compare the program name against the REQUEST_URI. sub IsRedirectLoop { @_ == 1 || die; my ($ru) = @_; $ru =~ s|\A\/||; # Delete leading / my $prog = $0; $prog =~ s|\A.*\/||; # Delete everything up through last / my $qprog = quotemeta($prog); return ($ru =~ m/\A$qprog/); } ######### RedirectLoopResponse ######### sub RedirectLoopResponse { my $response = 'Status: 400 Bad Request - Redirect loop Content-type: text/html Error 400: Bad Request - Redirect loop thing-described-by.org

Error 400: Bad Request - Redirect loop

The request would have caused a redirect loop. To view the files used to implement this site, see a directory listing and click on the file you wish to view.

For other help, see How to Mint a URI Using thing-described-by.org.



'; return $response; }