#! /usr/bin/perl # CGI script for displaying a file that would not otherwise # be viewable, for example an executable or .htaccess file. # It is normally invoked from .htaccess when ?showfile=f # query string is specified, which will display file f # as text/plain. # # Author: David Booth http://dbooth.org/2005/dbooth/ # Date: 5-Jun-2008 # License: Creative Commons GNU GPL: # http://creativecommons.org/licenses/GPL/2.0/ # For security, this script will only show files that # appear in the following list: my @permittedFiles = qw( . .htaccess redirect.pl showfile.pl error400-not-abs-uri.html.asis error400-query-string-not-allowed.html.asis index.html ); my %permittedFiles = map {($_,1)} @permittedFiles; my $debug = 0; # $ENV{'QUERY_STRING'} = $ARGV[0] if @ARGV; # print "Status: 200 OK\n"; # print "Content-type: text/plain\n\n"; print "Status: 200 OK\n" if $debug; print "Content-type: text/plain\n\n" if $debug; &ListEnv() if $debug; print "ARGV: {" . join(" ", @ARGV) . "}\n\n" if $debug; my $qs = $ENV{'QUERY_STRING'} . $path; ($qs =~ m/\Ashowfile\=(.*)\Z/) || &Respond("400 Bad Request", "No file specified via query string."); my $path = $1; while ($path =~ s@(\A|/)\./@\1@) {} # Collapse extra ./ while ($path =~ s@[^/]+/\.\.(\Z|/)@@) {} # Collapse extra foo/../ $path =~ s/\/\Z//; # Chop off final / if any $path = "." if $path eq ""; print "PATH: $path\n" if $debug; if ($permittedFiles{$path}) { my $f = $ENV{'DOCUMENT_ROOT'} . "/$path"; print "f: $f\n" if $debug; -e $f || &Respond("400 Bad Request", "File does not exist: $path"); -r $f || &Respond("400 Bad Request", "File is not readable: $path"); if (-d $f) { # List directory my @files = (); opendir($f, $f) || &Respond("500 Internal Server Error", "Failed to open directory: $path"); my @subfiles = (); while (my $sf = readdir($f)) { # push(@subfiles, "$sf") if $sf ne "." && $sf ne ".."; push(@subfiles, "$sf"); } closedir($f) || &Respond("500 Internal Server Error", "Failed to close directory: $path"); my $list = &LinkList($path, sort @subfiles); &Respond("200 OK", "Directory: $path", $list); } else { # Show plain file open($f, "<$f") || &Respond("500 Internal Server Error", "Failed to open file: $path"); my $content = join("", <$f>); close($f) || &Respond("500 Internal Server Error", "Failed to close file: $path"); print "Status: 200 OK\n"; print "Content-type: text/plain\n\n"; print $content; exit 0; } } else { &Respond("400 Bad Request", "You are not permitted to access file "$path".", "Permitted files are:\n\t" . &LinkList(".", @permittedFiles)); } # Should never get here: &Respond("500 Internal Server Error", "Fell through to end!"); exit 1; # Should never get here ########### LinkList ########### sub LinkList { @_ >= 1 || &Error("500 Internal Server Error", "Bad args to List function."); my ($path, @items) = @_; print "LinkList path: $path\n" if $debug; return "
\n" if !@items; my $list = "\n"; return $list; } ########### Respond ############## sub Respond { @_ == 2 || @_ == 3 || die; my ($status, $title, $body) = @_; $body = $title if !defined($body); $title = "$status: $title" if $status !~ m/\A200\b/; # print "status: $status\ntitle: $title\nbody: $body\n\n" if $debug; my $response = 'Status: $status Content-type: text/html $title

$title

$body '; $response =~ s/\$status/$status/g; $response =~ s/\$title/$title/g; $response =~ s/\$body/$body/g; print $response; exit 0; } ########## ListEnv ########### sub ListEnv { foreach my $k (sort keys %ENV) { my $v = $ENV{$k}; print "$k = $v\n"; } print "-------------------------------\n"; }