#!/usr/local/bin/perl
# otherdir.cgi  by David Efflandt  tech@de-srv.com
# last updated 9/29/00
#
# Since the default index of files is broken on some hosts I wrote
# this substitute to automatically lists links to all files in a
# directory (except hidden and @xfiles list).
#
# You can rename it anything you want to, but CGI usually needs to end
# with .cgi file extension.  You can pass it parameters is a query string.
#
#	path - relative path for both dir and url
#	dirpath - full or relative system path
#	urlpath - full or relative url path
#
# Example:
#
#	otherindex.cgi?dirpath=../htdocs&urlpath=..
#
# Files mentioned below should be in dir being listed.
#
# See http://www.apache.org/ for more info on following (case sensitive):
# Inserts 'HEADER.html' or 'HEADER' (text) file as header.
# Inserts 'README.html' or 'README' (text) file as footer.
#
# Parses '.htaccess' or an alternate file for: 
# AddDescription "description" filespec
# Note: Any of the usual apache directives related to indexing that I
# try to put in .htaccess causes a server error on virtualave.net.
# So put AddDescription lines in an alternate file (see $descfile).

use CGI qw/:standard/;


### User Variables ###

# default full or relative system path
my $dirpath = '..';

# default url full or relative url path (without domain)
my $urlpath = '..';

# Paths not allowed
my @badpaths = qw(/etc /bin /sbin /usr/sbin /root /lib);

# Maximum uplevels (..) allowed in path (to keep in web directories)
my $maxup = 1;

# File to search for AddDescription (.htaccess or another file):
my $descfile = '.desclist';	# begin with dot to hide file

# Note: Hidden (dot) files are automatically excluded.
# Exclude files (quoted, comma separated list):
my @xfiles = (
'HEADER',
'README',
'HEADER.html',
'README.html',
);

###  End  Variables  ###


use vars
qw/$url @url @insert @lines $desc $types @types @match @links $key %desc/;

$url = url(-absolute=>1);       # path to script
$url =~ s|/[^/]+$||;            # prune script name
$dirpath = param('dirpath') if param('dirpath');
$urlpath = param('urlpath') if param('urlpath');
if (param('path')) { $dirpath = $urlpath = param('path'); }
@url = split /\//,$urlpath;
foreach (@url) { $url =~ s|/[^/]+$|| if m|\.\.|; }
print header,start_html("Index of $url"),"\n";

$dirpath =~ s|/$||; $urlpath =~ s|/$||;
if ( grep(/^\Q$dirpath\E/,@badpaths)
  || (scalar(grep(/\.\./,@url)) > $maxup)) {
    print h1("Error"),hr,"Invalid or rejected path $dirpath";
    exit;
} else {
    chdir $dirpath;
}
unless (opendir DIR,'./')
    { print "Can't open dir $dirpath: $!\n"; exit; }
my @all = sort grep !/^\./, readdir DIR;	# skip dot files
closedir DIR;

my @insert = grep /^(HEADER|HEADER.html)$/, @all;
if ($_ = pop @insert) {
    if (open IN,"$_") {
        flock(IN,2); seek(IN,0,0);
        if (/^HEADER.html$/) { print <IN>; }
        else { print pre(<IN>); }
    }
    close IN;
} else {
    print h1("Index of $url");
}
print "\n";

if (open IN,"$descfile") {
    flock(IN,2); seek(IN,0,0);
    @lines = <IN>;
    close IN;
    while ($_ = pop @lines) {
        if (/AddDescription\s*"([^"]+)"\s*(\S.*)$/) {
            $desc = $1; $types = $2;
            @types = split(' ',$types);
            foreach $key (@types) {
                @match = glob($key);
                push @match,grep(/$key/,@all) unless $key =~ /[\*\?\{\$]/;
                foreach (@match) { $desc{$_} = $desc; }    
            }
        }
    }
}

dolink('..');		# parent dir
foreach $key (@all) {
    chomp $key;
    next if grep(/$key/,@xfiles);	# skip excluded files
    dolink($key);
}
print p,table({cellpadding=>2},Tr([
td([font({face=>'courier'},'Name'),
font({face=>'courier'},'Last Modified'),
font({face=>'courier'},'Size'),
font({face=>'courier'},'Description')]),
td({colspan=>4},[hr]),@links])),"\n",p;

my @insert = grep /^(README|README.html)$/, @all;
if ($_ = pop @insert) {
    if (open(IN,"$_")) {
        flock(IN,2); seek(IN,0,0);
        if (/^README.html$/) { print <IN>; }
        else { print pre(<IN>); }
    }
}
print end_html,"\n";


sub dolink {
    my($uri) = @_;
    my $update = scalar localtime((stat($uri))[9]);
    if ($update =~ /^(\w+) (\w+)\s+(\d+) (\d+:\d+):\d+ (\d+)$/) {
        if ($3 < 10) { $_ = "0" } else { $_ = ''; }
        $update = "$_$3-$2-$5 $4";
    }
    my $size = -s $uri;
    $size = int(($size + 1024) / 1024);
    $size .= 'K';
    ($desc = $desc{$uri}) || ($desc = '&nbsp;');
    if (-d $uri) { $uri .= '/'; $size = '-'; }
    my $link = $uri;
    $link = 'Parent Directory' if $uri eq '../';

    push @links,
    td([font({face=>'courier'},a({href=>"$urlpath/$uri"},$link)),
    font({face=>'courier'},$update)]).
    td({align=>'right'},[font({face=>'courier'},$size)]).
    td([font({face=>'courier'},$desc)]);
}