#!/usr/bin/perl -W
use strict;
# name: File Index
# author: Matt Rankin
# purpose: Displays a recursive file/directory listing.
# details: Can associate an external stylesheet and an external JavaScript file
# for further customisation. Excludes itself, '.' and '..', any
# files/dirs without read permissions for 'other', and any other files
# you don't want served up to the general public. This will become
# easier to configure when I get around to it.
# usage: Copy into all web-servable folders to be indexed and either rename
# to 'index.cgi' or associate .pl files as CGI executables.
my @styles=(
'h1{ font-size:1.5em; }',
'ul{ font-family:monospace; margin-bottom:0.25em; }',
'li{ line-height:1.25em; }',
'a:link,a:visited{ color:#999; font-weight:bold; text-decoration:none; }',
'a:hover{ color:#fff; text-decoration:underline; }',
'a.path{ text-decoration:underline; }',
'span.pwd{ color:#fff; background-color:#222; }',
'a.dir{ font-size:1.1em; }',
'a.pl{ color:#393; }',
'a.pl:hover{ color:#6f6; }',
'a.java{ color:#33f; }',
'a.java:hover{ color:#39f; }',
'a.ml{ color:#c63; }',
'a.ml:hover{ color:#f96; }');
# ---------------------------------- output -----------------------------------
print("Content-type: text/html\n\n");
print("\n");
print("\n");
print("\n".&head("File Index","retro.css",@styles)."\n\n");
print("\n".&body("Index")."\n\n");
print("");
# -------------------------------- subroutines --------------------------------
sub head{
my $title=shift;
my $css=shift;
my $out=" $title\n";
$out.=" \n";
if(defined @_){
$out.=" ";
if(defined @_){
$out.="\n "
}
}
return $out;
}
sub body{
my $out="
Apache/1.3.33 Server at ".
"redgum.bendigo.latrobe.edu.au Port 80
";
return $out;
}
sub list_contents{
my $pwd=shift;
my $ind=shift;
my @files=&list($pwd);
my $dir;
foreach(@files){
if(-d "$pwd/$_"){
$dir.=&build_line($_,$pwd,"$ind ");
$dir.="
\n";
}else{
$dir.=&build_line($_,$pwd,"$ind ");
}
}
return $dir;
}
sub list{
my $pwd=shift;
opendir(DIR,$pwd);
my @raw=readdir(DIR);
my(@dir,@file);
closedir(DIR);
foreach(@raw){
my $p=sprintf("%04o",(stat("$pwd/$_"))[2] & 07777);
unless(m/^\.{1,2}|index\.cgi|env\.cgi/ or $p=~m/[0-3]$/){
if(-d){ push(@dir,$_); }
else{ push(@file,$_); }
}
}
return (@dir,@file);
}
sub build_line{
my $fname=shift;
my $pwd=shift;
my $ind=shift;
my $size=&print_size("$pwd/$fname");
my $line="$ind