#!/usr/local/bin/perl5
# Name: index.cgi		Author: Joe Smith <js-cgi@inwap.com> 11-Feb-1996
# This is http://www.inwap.com/mybin/list-files.pl, it needs to be saved as
# index.cgi on your directory.  See also list-pics.pl which displays pictures.
#
# Purpose: Creates a sorted listing of the current directory.
#	   Like the NCSA/Apache httpd, this includes any HEADER and README
#	   files.  One-line descriptions of the files are kept in "index.txt".
#	For files that are not listed in index.txt, the <TITLE> line is
#	used for HTML files, the "# Purpose:" line is used for shell scripts,
#	and for everything else, /usr/bin/file is asked to read /etc/magic.
#
# This CGI was created explicitly for www.best.com, since the web server
# there provides only a rudimentary listing for directories (name and size
# only, unsorted).  This script should work just fine on any web server that
# supports perl CGI.  In particular, it has been used under Windows-95 with
# the Sambar http server.  (http://www.sambar.com/)
#
# See http://www.inwap.com/mybin to see this script in action.
# See http://www.inwap.com/inwap/cats/ to see list-pics.pl in action.
#
# Invoking this script as "./index.cgi -" will update index.txt.
#
# Three special entries can appear in index.txt: "." ".." and "-".
# .   The description for "." will appear on each page in an <H1>...</H1>.
# ..  The description for ".."; defaults to "Parent directory".
# -   The line for "-" can have one or more of the following keywords:
#	sort=bydesc => display names by description, as specified in index.txt
#	sort=byname => display names in alphabetic order (default)
#	sort=bydate => display names with newest first
#	sort=bysize => display names with biggest file first, directories last
#	dates       => display date/time next to file size
#	nodates     => don't display date/time next to file size
#	table       => put the results into an HTML table (default)
#	notable     => put <PRE> and </PRE> around the directory listing
#	bgcolor="#cccccc"   => use gray background (default is "#FFFFCC")
#	background="bg.gif" => use bg.gif for background
#	namewidth=20        => truncate names wider than 20 characters
# Use "<BR>" for "." if needed to break the text into multiple lines.

# Set $cgi to `basename $0`
unless (($dir,$cgi) = $0 =~ m%(.*)/(.*)%) {($dir,$cgi) = (".",$0);}
$| = 1;		# Use XSTDERR in case server gets upset when STDERR is closed
#open(XSTDERR,">&2"); open(STDERR,">&1"); # Send any error message to STDOUT

# Configuration section

$index_txt = "index.txt";	# Name of file with file descriptions
$bgcolor = "#FFFFCC";		# FFFFCC = Pastel yellow, DDDDDD = light gray
$namewidth = 20;		# Truncate names longer than this in listing
@header = ("HEADER", "HEADER.txt", "HEADER.html");	# Displayed first
@readme = ("README", "README.txt", "README.html");	# Displayed last
@noshow = (@header, @readme, $cgi, $index_txt, "core");	# Do not list these
@html_ext = ("html", "htm", "shtml", "sht");		# Extensions for html

# If there are any command line arguments, it means that either
# 1) The owner of the directory used "./index.cgi -" to update index.txt, or
# 2) <A HREF="index.cgi?fubar.cgi"> was used to display fubar.cgi as text.

$single = $ENV{'QUERY_STRING'} || join("+",@ARGV);
$this_cgi = $cgi eq "index.cgi" ? "?" : "$cgi?";	# For file references
$dir_cgi  = $cgi eq "index.cgi" ? ""  : $cgi;		# For index

($dirname) = $dir =~ m%.*/(.*/.*)%;	# Last two components of path name
($dirname) = $dir =~ m%.*/(.*)% unless $dirname;
if ($dir =~ m%^/%) {
  $dir_dir = "";
} else {
  chdir $dir or warn "chdir($dir): \n";	# Relative path, called by index.shtml
  $dir_dir = "$dir/";
}
$dir_cgi  = "$dir_dir$dir_cgi";

# Get file descriptions and option settings from index.txt

@index = &read_desc($index_txt);	# Read index.txt
&read_options($desc{'-'});		# Parse options on the '-' line
if (! defined $desc{'..'}) {
  $_ = &DIR_title('..');		# Search ../index.txt and ../index.html
  $_ = "Parent directory" if $_ eq "directory";
  $desc{'..'} = $_;
}

if ($single =~ /sort=(\w+)/) {
  $sort = $1; $reverse = "";
  $single = "";
}
if ($single =~ /reverse=(\w+)/) {
  $sort = $1; $reverse = 1;
  $single = "";
}

# If a name was specified, output that file as plain text.
# (This is used to allow people to look at the source of a .cgi file.)

$single =~ tr%/<|>\\%%;		# Only allow files in the current directory
if ($single && $single ne "-" && -f $single) {	# To get to source of *.cgi
  print "Last-Modified: ",gmdate((stat _)[9]),"\nContent-type: text/plain\n\n";
  if (open(IN,$single)) {
    print <IN>; close(IN);
  } else {
    print "$cgi: Unable to open $single for reading: $!\n";
  }
#  close(XSTDERR);
  exit;
}

# At this point, either no name was specified, or a file name was given but
# that file does not exist.  In either case, output a full directory listing.
# Get list of files in this directory, excluding dot files and such

foreach $_ (@noshow,"list-pics.pl","list-files.pl","index.cgi") {
  $exclude{$_} = 1 unless $desc{$_};
}
$namew = &read_dir(".");		# Set %date and %size
if ($namew == 0) {
  print "Content-type: text/plain\n\nDirectory $dir is unreadable: $!\n";
  exit;
}
$namew = 4 if $namew < 4;		# Minimum name width
$namew = $namewidth if $namew > $namewidth; # Leave room for size and desc

# Make sure each file name has some sort of description

@missing_desc = ();
foreach $file (keys %size) {
  ($ext = $file) =~ s/.*\././; $ext = "unknown" unless $ext;
  unless ($desc = $desc{$file} || $desc{$ext}) {
    $desc = &filedesc($file);		# Read file to get a description
    $desc{$file} = $desc || "*$ext file";
    push(@missing_desc,sprintf("%-15s\t%s\n",$file,$desc)) if $desc;
  }
}

# Update index.txt if invoked from command line as "./index.cgi -"

if ($single eq "-") {
  if (@missing_desc) {
    if (open(FILE,">>$index_txt")) {
      print FILE @missing_desc;		# Avoid calling &filedesc next time
      close(FILE);
      print "Added ",$#missing_desc+1," lines to $index_txt\n",@missing_desc;
    } else {
      print "Unable to append descriptions to $index_txt: $!\n",@missing_desc;
    }
  }
#  close(XSTDERR);
  exit;
}

if (defined $ENV{DOCUMENT_NAME}) {	# Ignore index.shtml if called from it
  foreach $ext (@html_ext) {
    $_ = "index.$ext";		# Don't list directory if index.html exists
    $desc{$_} = "-";
  }
  $desc{".."} = "-";
} else {
  if ($cgi =~ /index/) {
    foreach $ext (@html_ext) {
      $_ = "index.$ext";	# Don't list directory if index.html exists
      if (-f $_) {
	print "Location: $_\n\n<A HREF=\"$_\">$_</A> is the index file.\n";
	exit;	# Let index.html keep hidden files hidden
      }
    }
  }
}

sub bysize {return $size{$b} <=> $size{$a};}	# Largest first
sub bydate {return $date{$b} <=> $date{$a};}	# Newest first

if ($sort eq "bysize") {
  @files = sort bysize keys %size;	# Largest file first
} elsif ($sort eq "bydate") {
  @files = sort bydate keys %date;	# Newest file first
} elsif ($sort eq "bydesc") {
  @files = &ordered(keys %date);	# List in same order as in index.txt
} else {
  @files = sort keys %size;		# Default is "byname";
}
@files = reverse @files if $reverse;

# Create an HTML listing of the files in this directory

if (defined $ENV{DOCUMENT_NAME}) {
  print "Content-type: text/html\n\n" if $cgi =~ /cgi$/;
  $anchor = "#index";
} else {
  $title = "Files in directory '$dirname'";
  print "Content-type: text/html\n\n<HTML><HEAD><TITLE>$title</TITLE></HEAD>\n";
  $anchor = "";
  $body = qq|BGCOLOR="$bgcolor"| unless $body;
  print "<BODY $body>\n";
  print "The file <b>$index_txt</b> does not exist.<br>It should contain one-line
       descriptions of the files in this directory.\n" unless -f $index_txt;
}
print "<H1>$desc{'.'}</H1>\n" if $desc{'.'};	# Current directory's desc

&show_files(@header);			# Display HEADER first

if ($sort eq "byname" && ! $reverse) {
  $byname = qq|<A NAME="index" HREF="$dir_cgi?reverse=byname$anchor">Name</A>|;
} else {
  $byname = qq|<A NAME="index" HREF="$dir_cgi?sort=byname$anchor">Name</A>|;
}
if ($sort eq "bysize" && ! $reverse) {
  $bysize = qq|<A HREF="$dir_cgi?reverse=bysize$anchor">Size</A>|;
} else {
  $bysize = qq|<A HREF="$dir_cgi?sort=bysize$anchor">Size</A>|;
}
if ($sort eq "bydate" && ! $reverse) {
  $bydate = qq|<A HREF="$dir_cgi?reverse=bydate$anchor">Last modified</A>|;
} else {
  $bydate = qq|<A HREF="$dir_cgi?sort=bydate$anchor">Last modified</A>|;
}
if ($sort eq "bydesc" && ! $reverse) {
  $bydesc = qq|<A HREF="$dir_cgi?reverse=bydesc$anchor">Description</A>|;
} else {
  $bydesc = qq|<A HREF="$dir_cgi?sort=bydesc$anchor">Description</A>|;
}
if ($table) {
  print "<TABLE>\n";
  $f2 = "<font size=2><tt>"; $f3 = "</tt></font>";
  if ($showdates) {
    print "<TR><TH ALIGN=LEFT>$byname<TH>$f2$bysize$f3" .
		"<TH ALIGN=CENTER>$f2$bydate$f3<TH ALIGN=LEFT>$bydesc</TR>\n";
    $format = "<TR><TD>%s<TD ALIGN=RIGHT>$f2%s$f3<TD>$f2%s$f3<TD>%s\n";
    $divider = "<TR><TD COLSPAN=4><HR></TR>\n";
    ($header1,$header2) = ("<TR><TH COLSPAN=4>", "</TR>\n");
  } else {
    print "<TR><TH ALIGN=LEFT>$byname<TH>$f2$bysize$f3" .
		"<TH ALIGN=LEFT>$bydesc</TR>\n";
    $format = "<TR><TD>%s<TD ALIGN=RIGHT>$f2%s$f3<TD>%s\n";
    $divider = "<TR><TD COLSPAN=3><HR></TR>\n";
    ($header1,$header2) = ("<TR><TH COLSPAN=3>", "</TR>\n");
  }
  $end_of_list = "</TABLE>\n";
} else {
  print "<PRE>";
  $f2 = "<font size=2>"; $f3 = "</font>";
  $pad = " " x ($namew - 4);
  if ($showdates) {
    print "$byname$pad $f2 $bysize   $bydate  $f3  $bydesc\n";
    $format = "%s $f2%5s %s$f3  %s\n";
  } else {
    print "$byname$pad $f2 $bysize$f3  $bydesc\n";
    $format = "%s $f2%5s$f3  %s\n";
  }
  $end_of_list = "</PRE>\n";
  $divider = "<HR>\n";
  ($header1,$header2) = ("<BIG>", "</BIG>");
}

# List filename as hyperlink, size, and description

while ($file = shift @files) {
  print($divider),next if $file eq "-" && @files;
  print($header1,$1,$header2),next if $file =~ /^\. (.*)/;
  $desc = $desc{$file};
  next if $desc eq "-";
  $fil = substr($file,0,$namew);
  if (-d $file) {
    $href = "$file/";		# Use trailing slash on directory
    $fil = substr($file,0,$namew-1) . "/";
    $size = "[DIR]";
  } else {
    $href = $file;		# Hyperlink to file
    $href = "$this_cgi$file" if $file =~ /\.cgi$/; # Display cgi without exec
    $href = "$this_cgi$file" if $file =~ /\.pl$/;  # Display cgi without exec
    $href = "$this_cgi$file" if $dir eq "cgi-bin"; # Display cgi without exec
    $href = "$this_cgi$file" if $file !~ /\./ && -T _; # Text/plain if no ext
    $size = sprintf("%4dK",int(($size{$file}+1023)/1024));	# Round up
  }
  $pad = " " x ($namew - length($fil));
  $href = "$dir_dir$href";
  if ($showdates) {
    $date = &date($date{$file});
    printf($format,"<A HREF=\"$href\">$fil</A>$pad",$size,$date,$desc);
  } else {
    printf($format,"<A HREF=\"$href\">$fil</A>$pad",$size,$desc);
  }
}
print $end_of_list;			# </PRE> or </TABLE>
&show_files(@readme);		# Display README file last, if it exists

# Finish up - output error messages and an indication of CPU time used

print "Unrecognized option '- $optionx'<BR>\n" if $optionx;
print "Error: $error_msg<BR>\n" if $error_msg;
eval '(@cpu) = times;' if $cputime;  # (user,sys,childuser,childsys), UNIX only
printf "<div align=right>\t\t(CPU seconds: user=%.3f system=%.3f)</div>\n",
	$cpu[0]+$cpu[2],$cpu[1]+$cpu[3] if defined @cpu; # Not on Windows-95
print "</BODY></HTML>\n" if defined $ENV{DOCUMENT_NAME} && $cgi =~ /cgi$/;
#close(XSTDERR);
exit;

###########################################################################

sub date {		# Returns formatted string of file's date
  local($xx,$min,$hour,$mday,$mon,$year) = localtime($date{$file});
  $xx = substr("JanFebMarAprMayJunJulAugSepOctNovDec",$mon*3,3);
  return sprintf("%02d-%s-%d %02d:%02d",$mday,$xx,$year+1900,$hour,$min);
}

sub gmdate {		# Returns "Sat, 09 Jan 1999 00:06:14 GMT"
  local($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($_[0]);
  local($Mon) = substr("JanFebMarAprMayJunJulAugSepOctNovDec",$mon*3,3);
  local($Day) = substr("SunMonTueWedThuFriSat",$wday*3,3);
  return sprintf("%3s, %02d %3s %4d %02d:%02d:%02d GMT",
		$Day, $mday, $Mon, $year+1900, $hour, $min, $sec);
}  

sub read_desc {		# Reads index.txt in current directory
  local($file,$desc,@namelist);
  if (open(IN,$_[0])) {
    while(<IN>) {		# Look for "filename Description of file"
      ($file,$desc) = split(' ',$_,2);	# Spaces or tab
      chop $desc;
      $desc{$file} = $desc;
      push(@namelist,$file);	# Remember order for "- ordered"
    }; close(IN);
  }
  unshift @namelist,".." unless $desc{".."};
  @namelist;			# Return a list of names, in order
}

sub read_options {	# Get options from the "-" line of index.txt
  local($options) = @_;
  $table = $showdates = 1; $sort = "bydesc";
  $optionx = $body = $reverse = $cputime = "";
  foreach $_ (split(' ',$options)) {
    ( /sort=(bydesc|byname|bysize|bydate)/  && ($reverse = "",$sort = $1)) ||
    ( /reverse=(bydesc|byname|bysize|bydate)/ && ($reverse=1, $sort = $1)) ||
    ( /namewidth=(\d+)/			&& ($namewidth = $1)	) ||
    ( /nodates/				&& ($showdates = 0, 1)	) ||
    ( /dates/				&& ($showdates = 1)	) ||
    ( /notable/				&& ($table     = 0, 1)	) ||
    ( /table/				&& ($table     = 1)	) ||
    ( /cputime/				&& ($cputime   = 1)	) ||
    ( /(bgcolor=.*|background=.*)/i	&& ($body    .= "$1 ")	) ||
    ( 1					&& ($optionx .= "$_ ")	);
  }
}

sub read_dir {		# Read directory, set %size, %date and $namewidth
  local($rel_dir) = @_;
  local($namelength) = 0;
  opendir(DIR,$rel_dir) || return 0;
  foreach $_ ("..",grep(!/^\./,readdir(DIR))) {	# Skip dot files, include ".."
    next if defined $exclude{$_};
    $_ = "$rel_dir/$_" if $rel_dir ne ".";	# Use right name for stat()
    ($size{$_},$date{$_}) = (stat $_)[7,9];
    ($size{$_},$date{$_}) = (-1,$^T) if -d _;	# Dir => minus size, this date
    $namelength = length($_) if length($_) > $namelength;
    $namelength = length($_)+1 if length($_) == $namelength && (-d _);
  }; closedir(DIR);
  return $namelength;
}

sub ordered {		# Re-orders array of names to match index.txt
  local(%other,@result);	# Uses @index and %desc
  foreach $_ (@_) { $other{$_} = 1; }	# List of files in the directory
  # For each name in @index, if the file exists, put in in @result and
  # remove it from the %other hash to signify that the name has been seen.
  foreach $_ (@index) { push(@result,$_),delete($other{$_}) if $other{$_}; }
  push(@result,"-",sort(keys %other)) if %other;	# "-" is divider
  @result;				# Return ordered list
}

sub filedesc {		# Creates a description of a file by reading it
  local($filename) = @_;
  local($ext) = $filename; $ext =~ s/.*\.//;
  if (-l $filename) {
    return "Symlink to " . readlink($filename);
  } elsif (-d _) {
    return &DIR_title($filename);	# Search for TITLE in index.html
  } elsif (grep($ext =~ /$_/i, @html_ext)) {
    return &HTML_title($filename);	# Look for <TITLE>text</TITLE>
  } else {
    local($string);
    if (-x $filename && ($string = &SCRIPT_purpose($filename))) {
      return $string;			# Shell scripts or perl programs
    }
    if (-x "/usr/bin/file") {		# If running on UNIX
      chop($string = `/usr/bin/file '$filename'`);	# It uses /etc/magic
      $string = substr($string,length($filename)+2);	# Strip "name:\t"
      return $string;
    }
    return "";	# Null result for Win-95 (parsing the registry is not worth it)
  }
}

sub DIR_title {		# Look for description in index.html or index.txt
  local($dirname) = shift;
  foreach $_ (@html_ext) {
    return(&HTML_title("$dirname/index.$_")) if -f "$dirname/index.$_";
  }
  open(IN,"$dirname/$index_txt") || return "directory";
  while(<IN>) {
    /^\.\s+(.*)/ && return($1);		# Find line with "."
  }; close(IN);
  return "directory"
}

sub SCRIPT_purpose {	# Look for "Purpose: description" in perl or sh CGI
  local($fn) = shift;
  open(IN,$fn) || return "";
  local($i);
  for $i (1 .. 20) {	# Check just the first 20 lines of the file
    $_ = <IN>;
    if (s/^\s*#\s*Purpose:\s+(.*)/$1/) {
      s/&/&amp;/g; s/</&lt;/g; s/>/&gt;/g;
      return $_;
    }
  }
  return "";
}

sub HTML_title {	# Look for "<TITLE>description</TITLE>"
  local($fn) = shift;
  open(IN, $fn) || return "$fn: $!";
  local($/,$_) = (undef,"");		# To read entire file as one string
  $_ = <IN>; close(IN);
  if (/<title>([^<]*)</i) {
    $_ = $1;
    s/\s+/ /g;
    return $_;
  } else {
    return "HTML document";
  }
}

sub show_files {	# Displays one or more files, with <HR> before & after
  local($count) = 0;
  foreach $_ (@_) {		# ("X", "X.txt", "X.html") for HEADER & README
    if (-f $_ && open(IN,$_)) {
      print "<HR>\n" unless $count++;
      if (/\.html?$/) {
        print <IN>,"<HR>\n";	# Display HEADER.html or README.html
      } else {
	local($/) = undef;	# Read file as single string
	local($text) = <IN>;
	$text =~ s/&/&amp;/g;
	$text =~ s/</&lt;/g;
	$text =~ s/>/&gt;/g;
	print "<PRE>$text</PRE><HR>\n";
      }
      close(IN);
    } else {
      print("<pre> Cannot read $_: $! </pre>\n") if -f $_;
    }
  }
}