Programming in Perl
By Randal Schwartz
Web Techniques, October 1997
Web Techniques grants permission to use these listings for private or
commercial use provided that credit to Web Techniques and the author is
maintained within the comments of the source. For questions, contact
editors@web-techniques.com.
PERL
Listing One
#!/home/merlyn/bin/perl -wT
use strict;
use URI::URL;
## configuration
my $BASE = "/merlyn/WebTechniques/"; # must end in slash
my $VALID_SECONDS = 60 * 60 * 4; # four hours
## end configuration
## return $_[0] encoded for HTML entities
sub ent {
local $_ = shift;
$_ =~ s/["<&>"]/"&#".ord($&).";"/ge; # entity escape
$_;
}
my $info = $ENV{PATH_INFO};
$info = "/" unless defined $info;
$info = ".$info"; # always "./" prefix
my $self_url = url("http:");
$self_url->host($ENV{SERVER_NAME}) if defined $ENV{SERVER_NAME};
$self_url->port($ENV{SERVER_PORT}) if defined $ENV{SERVER_PORT};
$self_url->path($ENV{SCRIPT_NAME} || "/cgi/$0");
$self_url = "$self_url/"; # note that $self_url is a string now
my $when = 0;
$when = $1 if $info =~ s!^\./(\d+)/!./!;
## catchall if illegal url (attempt to back up over top)
## or expired (and not one of the entries into the tree)
if (
(index("/$info/", "/../") > -1) or
$info ne "./" and
time > $when + 2 * $VALID_SECONDS) { # hard expired URL, say so
my $r_html = ent("$self_url$info");
my $s_html = ent($self_url);
print <<"EOF";
Content-type: text/html
Status: 404 Not Found
<HTML><TITLE>Expired URL</TITLE></HEAD>
<BODY><H1>Expired URL</H1>
The requested URL $r_html has expired. Please return to
<A HREF="$s_html">$s_html</A> to start with a new unexpired URL.
</BODY>
EOF
exit 0;
}
my $location =
url($info, # $info is relative to...
(time > $when + $VALID_SECONDS) ? # if too old...
$self_url.time."/" : # this script and time (external redirect)
$BASE # or use as-is (internal redirect)
)->abs; # made absolute
print "Location: $location\n";
print "\n";