#!/usr/local/bin/perl use File::Basename; # *********************************************************************** # # * * # # * Copyright (c) 1996-1999 Scott Crevier * # # * All Rights Reserved Worldwide * # # * * # # * This program product material is the property of Scott Crevier. * # # * This program may be used and modified by anyone free of charge, * # # * as long as this copyright notice remains in tact. By using this * # # * code, you agree to indemnify Scott Crevier from any liability * # # * that might arise from its use. * # # * * # # * scott@crevier.org - Scott M. Crevier - www.crevier.org * # # *********************************************************************** # # * smcPYPO.pl v2.1 16-Jan-1999 * # # * * # # * I call this script "Pull Your Page Out" because it "pulls out" * # # * the source of your web pages and shows it to you. * # # * * # # * This script allows you to browse the source of your entire web * # # * site. The display is very similar to that which you see in a * # # * listing of a directory with no index file. The BIG difference * # # * is that when you click on an HTML file, for example, you view the * # # * SOURCE of that file and not the formatted web page. You also see * # # * the source of all CGI scripts and any other text files. If you * # # * click on an image, it is displayed for you. * # # * * # # * Due to the sensitive nature of the content displayed, you may * # # * want to put this script in a secured directory (with .htaccess) * # # * which requires user authentication. * # # * * # # *********************************************************************** # # *********************************************************************** # # * Variable Definitions: * # # * * # # * vlogin Turn this option on (1) if you want the script to * # # * make sure the user has logged in first, before * # # * displaying any content. * # # * * # # * icons_url The URL to the directory where icons reside. * # # * * # # * NOTE: Your web server probably already has a set of icons * # # * that you can use. They are the icons displayed in a * # # * directory listing where there is no index file. Just * # # * go to such a directory in your browser and view the * # # * source. Or if you'd like, you can get a good set of * # # * icons at: * # # * * # # * http://www.eit.com/goodies/www.icons/ * # # * http://www.netlimited.net/icons/ * # # * * # # * Also, be sure to set/verify all the settings in the * # # * %ICON hash below. * # # * * # # * IMPORTANT: I have set the $icons_url variable to a good default * # # * value that should allow you to get this script up and * # # * running quickly. Although you might experiment with * # # * some external values, remember that it is not polite * # # * to display images that are not hosted on your web site. * # # * * # # *********************************************************************** # $vlogin = 0; #$icons_url = 'http://www.netlimited.net/icons'; $icons_url = '/icons'; %ICON = ( 'avi' => $icons_url . '/movie.gif', 'cgi' => $icons_url . '/script.gif', 'dat' => $icons_url . '/text.gif', 'exe' => $icons_url . '/binary.gif', 'gif' => $icons_url . '/image2.gif', 'gz' => $icons_url . '/compressed.gif', 'htm' => $icons_url . '/text.gif', 'html' => $icons_url . '/text.gif', 'jpg' => $icons_url . '/image2.gif', 'link' => $icons_url . '/link.gif', 'mid' => $icons_url . '/sound2.gif', 'pdf' => $icons_url . '/pdf.gif', 'pl' => $icons_url . '/p.gif', 'ra' => $icons_url . '/sound2.gif', 'ram' => $icons_url . '/text.gif', 'shtml' => $icons_url . '/text.gif', 'tar' => $icons_url . '/tar.gif', 'txt' => $icons_url . '/text.gif', 'wav' => $icons_url . '/sound2.gif', 'z' => $icons_url . '/compressed.gif', 'zip' => $icons_url . '/compressed.gif', 'directory' => $icons_url . '/dir.gif', 'previous' => $icons_url . '/back.gif', 'unknown' => $icons_url . '/unknown.gif', ); $fullpath = $ENV{'DOCUMENT_ROOT'} . '/' . $ENV{'QUERY_STRING'}; @ddd = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); @mmm = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); # *********************************************************************** # # * M A I N * # # *********************************************************************** # &verifyLogin; if (-f $fullpath && -T _) { &httpHeader('text/plain'); &printFile($fullpath); } else { &httpHeader('text/html'); &printDirListing; } exit(0); # *********************************************************************** # # *********************************************************************** # # * S U B R O U T I N E S * # # *********************************************************************** # # *********************************************************************** # # *********************************************************************** # # * Print the standard HTTP header. * # # *********************************************************************** # sub httpHeader { print "Content-type: $_[0]", "\n\n"; } # *********************************************************************** # # * Make sure the user has logged in if required to do so. * # # *********************************************************************** # sub verifyLogin { if (($ENV{'REMOTE_USER'} eq '') && ($vlogin)) { print "Location: http://$ENV{'HTTP_HOST'}/\n\n"; exit(1); } } # *********************************************************************** # # * Print the contents of a file. * # # *********************************************************************** # sub printFile { my $f = $_[0]; if (-r $f) { open(F,$f) or die "$! \'$f\'"; while () { print; } close(F); } else { print "Sorry, cannot open file '$f'.\n"; } } # *********************************************************************** # # * This subroutine returns the time (passed in) in a nice format. * # # *********************************************************************** # sub timefmt { my $internaltime = $_[0]; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($internaltime); if ($hour < 12) { $ampm = 'am'; } else { $ampm = 'pm'; } if ($hour < 1) { $hour = 12; } elsif ($hour > 12) { $hour -= 12; } $year += 1900; $mday = sprintf("%02d", $mday); $hour = sprintf("%02d", $hour); $min = sprintf("%02d", $min ); $sec = sprintf("%02d", $sec ); return "$ddd[$wday] $mday\-$mmm[$mon]\-$year $hour\:$min\:$sec$ampm"; } # *********************************************************************** # # * Subroutine to insert commas into integers. * # # *********************************************************************** # sub commas { local($_) = @_; 1 while s/(.*\d)(\d\d\d)/$1,$2/; $_; } # *********************************************************************** # # * Subroutine to print file/directory information. * # # *********************************************************************** # sub printInfo { my $filepath = $_[0]; $filepath =~ s/\/\//\//g; my $fullpath = $ENV{'DOCUMENT_ROOT'} . $filepath; my($timestamp,$filenamex,$iconfile,$ext); # *************************************************************** # # * Determine which icon to use. * # # *************************************************************** # if ($fullpath =~ /\/\.\.$/) { $iconfile = $ICON{'previous'}; } elsif (-d) { $iconfile = $ICON{'directory'}; } elsif (-l) { $iconfile = $ICON{'link'}; } else { $ext = $fullpath; $ext =~ s/^.*\.(.*)$/$1/; $iconfile = $ICON{$ext} ne '' ? $ICON{$ext} : $ICON{'unknown'}; } # *************************************************************** # # * Get info on the file. * # # *************************************************************** # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($fullpath); $timestamp = &timefmt($mtime - 10800); $filenamex = basename($fullpath); # *************************************************************** # # * Print the icon. * # # *************************************************************** # print "\"$iconfile\" "; # *************************************************************** # # * Print the filename. * # # *************************************************************** # if (-r $fullpath) { $filenamex .= ''; print "%-27.27s ", $filepath, $filenamex); } else { printf ("%s\">%-27.27s ", $filepath, $filenamex); } } else { printf ("%-23.23s ", $filenamex); } print "$timestamp "; # *************************************************************** # # * Print the file size. * # # *************************************************************** # if (-d $fullpath) { print " --"; } else { printf ("%10.10s", &commas($size) ); } # *************************************************************** # # * Print symbolic link info. * # # *************************************************************** # if (-l $fullpath) { $otherfile = readlink; print " -> $otherfile"; } print "\n"; } # *********************************************************************** # # * Subroutine to print a directory listing. * # # *********************************************************************** # sub printDirListing { # *************************************************************** # # * Initialize some variables. * # # *************************************************************** # my $totalfiles = 0; my $totalbytes = 0; my $fulldir = $ENV{'DOCUMENT_ROOT'} . '/' . $ENV{'QUERY_STRING'}; # *************************************************************** # # * Read the directory contents into an array. * # # *************************************************************** # chdir $fulldir; opendir(DIR,'.') || die "Can't open ."; @filenames = readdir(DIR); closedir(DIR); # *************************************************************** # # * Print the top of the HTML page. * # # *************************************************************** # print "\n", "\n", "Scott Crevier's Pull Your Page Out\n", "\n", "\n", "
\n", "Pull Your Page Out!\n", "
\n", "

\n"; # *************************************************************** # # * Print the column headings. * # # *************************************************************** # print "

Current location: ",
		"",
		"http://$ENV{'HTTP_HOST'}$ENV{'QUERY_STRING'}\n",
		"
\"  ",
		"Name                    Last Modified                  Size\n",
		"
\n";

	# *************************************************************** #
	# *  Print the directory names.					* #
	# *************************************************************** #
	&printInfo($ENV{'QUERY_STRING'} . '/..');

	foreach (sort @filenames) {
		next if $_ eq '.';
		next if $_ eq '..';
		if (-d) { &printInfo($ENV{'QUERY_STRING'} . '/' . $_); }
	}

	print "
\n";


	# *************************************************************** #
	# *  Print the file names.					* #
	# *************************************************************** #
	foreach (sort @filenames) {
		if (-d) { next; }
		&printInfo($ENV{'QUERY_STRING'} . '/' . $_);
		if (!-l) {
			$totalfiles++;
			$totalbytes += $size;
		}
	}

	$totalbytes = &commas($totalbytes);

	# *************************************************************** #
	# *  Print the bottom of the HTML page.				* #
	# *************************************************************** #
	print	"
$totalfiles files ($totalbytes bytes)\n", "
\n", "
\n", "
\n", "Pull Your Page Out Copyright © 1996-1999 ", "Scott Crevier.\n", "
\n", "
\n", "\n", "\n"; } # *********************************************************************** # # * End. * # # *********************************************************************** #