|
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
|
Re: Perl Ripping Event (fwd)
|
Forwarded message:
> Message-ID: <20000302175438.17499.qmail@plover.com>
> To: phl@lists.pm.org
> Subject: Re: Perl Ripping Event
> Date: Thu, 02 Mar 2000 12:54:38 -0500
> From: Mark-Jason Dominus <mjd@plover.com>
>
>
> I found this in deja.com's news archive. It's from November 1994.
>
> It appears to be in Perl 4, and it's interesting to see how it might
> be been different if it had been written for Perl 5. But it also has
> a bug. Can you find it?
>
>
>
>
> #!/usr/local/bin/perl
> # -*- perl -*-
> #
> # Given a directory, generate an HTTP redirect message
> # to a file selected from the directory at random.
> #
>
> srand;
>
> $server_root = '/pkg/www/';
>
> @monthname = ("Jan","Feb","Mar","Apr","May","Jun",
> "Jul","Aug","Sep","Oct","Nov","Dec");
>
> @dayname = ('Sun', 'Mon', 'Tues', 'Wednes', 'Thurs', 'Fri', 'Sat');
>
> sub print_header {
> local($msg) = @_;
>
> return if $ENV{'SERVER_PROTOCOL'} eq 'HTTP/0.9';
> return unless $ENV{'SERVER_PROTOCOL'} eq 'HTTP/1.0';
>
> local($msglen) = length($msg);
> local($date) = &header_time();
>
> print <<EOM;
> HTTP/1.0 200 Document follows
> MIME-Version: 1.0
> Server: $ENV{'SERVER_SOFTWARE'}
> Date: $date
> Content-Type: text/html
> Content-Length: $msglen
>
> EOM
> return;
> }
>
> sub fail {
> local($msg) = <<EOM;
> Arg! Not enough args!
> \$\#ARGV was $#ARGV
> \@ARGV was .@ARGV.
> EOM
>
> &print_header($msg);
> print $msg;
> exit -1;
> }
>
> sub header_time {
> local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
> = gmtime;
> return "$dayname[$wday], $mday-$monthname[$mon]-$year $hour:$min:$sec GMT";
> }
>
> sub redirect_to_file {
> local($file) = @_;
> $file =~ s:^/*::;
> local($date) = &header_time();
> if ($ENV{SERVER_PORT} == 80) {
> $portstr = '';
> } else {
> $portstr = ":$ENV{SERVER_PORT}";
> }
>
> local($msg) = <<EOM;
> <HTML>
> <HEAD>
> <TITLE>Redirection</TITLE>
> </HEAD>
> <BODY>
> <H1>Redirection</H1>
> This document can be found
> <A HREF="http://$ENV{'SERVER_NAME'}${portstr}/$file">elsewhere.</A><P> You see
> this message because your browser doesn\'t support automatic redirection handeling. <P>
> <HR>
> <ADDRESS>webmaster@$ENV{'SERVER_NAME'}</ADDRESS>
> </BODY>
> </HTML>
> EOM
>
> local($msglen) = length($msg);
>
> print <<EOM;
> HTTP/1.0 302 Found
> MIME-Version: 1.0
> Server: $ENV{'SERVER_SOFTWARE'}
> Date: $date
> Location: http://$ENV{'SERVER_NAME'}${portstr}/$file
> Content-Type: text/html
> Content-Length: $msglen
>
> $msg
> EOM
> return;
> }
>
>
> ############################################################
> #
> # MAIN PROGRAM BEGINS HERE
> #
> ############################################################
>
> &fail() unless ($#ARGV >= 0);
>
> foreach $dir (@ARGV) {
> $dir =~ s:/*$::;
> unless (opendir(DIR, $server_root . $dir)) {
> warn "Can\'t open directory $server_root$dir: $!; skipping\n"; next;
> }
> @files_here = readdir(DIR);
> close DIR;
> foreach $f (@files_here) {
> next if $f =~ /^\.\.?$/;
> push(@files, "$dir/$f");
> }
> }
>
> &redirect_to_file($files[rand($#files)]);
>
> exit 0;
>
**Majordomo list services provided by PANIX <URL:http://www.panix.com>**
**To Unsubscribe, send "unsubscribe phl" to majordomo@lists.pm.org**
|
|