#!/usr/local/bin/perl -w # # $Id: redirect,v 1.1 2003/09/15 20:25:07 dgregor Exp $ # # Copyright (c) 1998-2001 Daniel J. Gregor, Jr., All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # 3. All advertising materials mentioning features or use of this software # must display the following acknowledgement: # This product includes software developed by Daniel J. Gregor, Jr. # 4. The name of Daniel J. Gregor, Jr. may not be used to endorse or promote # products derived from this software without specific prior written # permission. # # THIS SOFTWARE IS PROVIDED BY DANIEL J. GREGOR, JR. ``AS IS'' AND # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL DANIEL J. GREGOR, JR. BE LIABLE # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # # Usage: redirect [-temp | -perm] [] # # See section 10.3.2 (-perm) and 10.3.3 of RFC 2616.... # http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc2616.html # use strict; main(); sub main { my ($progname) = "redirect"; my ($usage) = <<"END_OF_USAGE"; $progname usage: redirect [-temp | -perm] [] END_OF_USAGE my (%option_return_code_mapping) = ( "-perm" => "301 Moved Permanently", "-temp" => "302 Found", ); my ($default_return_code) = "302 Found"; my ($return_code) = $default_return_code; if ((@ARGV > 0) && $ARGV[0] =~ m/^-/) {# we have a command-line argument my ($option) = shift(@ARGV); if (!exists($option_return_code_mapping{$option})) { die "$progname: invalid command-line option\n$usage"; } $return_code = $option_return_code_mapping{$option}; } if (@ARGV < 1) { die "$progname: too few command-line arguments\n$usage"; } my ($redirect_url) = shift(@ARGV); my ($log_file) = @ARGV ? shift(@ARGV) : undef; if (@ARGV > 0) { die "$progname: too many command-line arguments\n$usage"; } if (defined($log_file)) { open(LOG, ">>" . $log_file) || die "Could not open log file \"$log_file\": $!\n"; } # XXX does this need to be done? # unbuffer the i/o select((select(STDERR),$|=1)[0]); select((select(STDOUT),$|=1)[0]); my ($request); if (!defined($request = )) { if (defined($log_file)) { print LOG localtime(time()) . ": unable to read request method\n"; } } $request =~ s/[\r\n]+//; my (@request_array) = split(/\s+/, $request); if (@request_array != 3) { if (defined($log_file)) { print LOG localtime(time()) . ": invalid request \"$request\"\n"; } print <<"END_OF_HTTP_ERROR_MESSAGE"; Invalid Request

Invalid Request

Unable to handle invalid request:
$request
END_OF_HTTP_ERROR_MESSAGE exit; } my ($method, $url, $protocol) = @request_array; $method = uc($method); # uppercase the method if (defined($log_file)) { print LOG localtime(time()) . ": \"$method\" request for \"$url\"\n"; } while (1) { if (!defined($request = )) { if (defined($log_file)) { print LOG localtime(time()) . ": unable to read past headers\n"; } print <<"END_OF_HTTP_ERROR_MESSAGE"; Incomplete Request

Incomplete Request

Unable to handle incomplete request: the request was unexpected ended. END_OF_HTTP_ERROR_MESSAGE exit; } # Check for blank line => end of client's request & headers if ($request =~ m/^[\r\n]+$/) { last; } } print "HTTP/1.0 302 Moved\r\n"; print "Location: $redirect_url\r\n"; print "\r\n"; exit; }