#!/usr/freeware/bin/perl 
###!/usr/freeware/bin/perl -w
#use strict;

use Benchmark;
$t0 = new Benchmark;

##########################################################          
#                        FTPzuiger.pl                    #
#                                                        #
#              Cute html indexes for ftp sites :-)       #
#                                                        #
#             Written by Wessel de Roode 1-feb-1997      #               
#                                                        #
##########################################################

# How long should this page remain in HTTP-Proxies & Brouwser cashe
$EXPIRE_DAYS  = 1;
$EXPIRE_HOURS = 0;
$EXPIRE_MIN   = 0;
$EXPIRE       = $EXPIRE_DAYS*24*60*60+60*60*$EXPIRE_HOURS+$EXPIRE_MIN*60;
##$EXPIRE      = "Mon, Jan 13 10:47:05 1997 +0100";

# Header and Footer files of table
$HEADER       = "HEADER.html";
$FOOTER       = "README.html";
$DIR_ICON     = "/ns-icons/menu.gif";
$TXT_ICON     = "/ns-icons/text.gif";
$DIST_ICON    = "/ns-icons/binary.gif";
$BACK_ICON    = "/ns-icons/back.gif";
$BLANK_ICON   = "/ns-icons/blank.gif";
$BROKE_ICON   = "?";
$WIDTH=$HEIGHT="21";
#Table borders
$BORDERS      =0;

# This files contains all the files with their (html) discription
# <File>  <discription>
$DESCRIPTION  = "00index.txt";
$DESCRIPTION2  = ".htaccess";
# Cut away the following extensions in the table
$FILE_EXT=".tardist.gz|.tar|.Z|.zip";

# Find my excecution name
@ME= split ('/',$0); $ME=pop @ME;

# Enter all the extensions & files you don't want to have in the table
$DEFAULTSKIP  = ".cgi|.htacces|.nsconfig|$ME|fw_";
$SKIPFILES    = "$HEADER|$FOOTER|$DESCRIPTION|$DESCRIPTION2|$DEFAULTSKIP";
$SHIPDIRS     = "tmp|etc|lib";
# ---------------------------------------------------------------------------
# ----------------- Please keep this Copyright notice compleet   ------------
# ----------------- Feel free to change and use all of this code ------------
# ----------------- But if you make use of it leave the c. compleet ---------
# ---------------------------------------------------------------------------
$VERSION      = "0.9";
$COPRIGHT     = "</B><H6><P ALIGN=\"RIGHT\">
                               List was produced bij ftpzuiger.pl $VERSION<BR>
                                           written bij Wessel de Roode</H6>";

# ----------------------------------------------------------------------------
# ------------- There's no need to change things below this line :-) ---------
# ------------- End of user defined variables                        ---------
# ----------------------------------------------------------------------------

#open FDd,">/dev/console";
open FDd,">/dev/null";
#open(STDERR, ">&STDERR");
open (STDOUT,">&STDOUT");
open(STDERR, ">/dev/null");
select(STDOUT); $| = 1;   # make unbuffered
select(STDERR); $| = 1;   # make unbuffered

print FDd "\nFTPzuiger DEBUG output:\n"; 

# List files from this directory
$thisdir      = "./"; # !!!!!!!!!! Plaats dit nog voor de header readme etc !!!
$urlc       = ":\/\/$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}";
$urlc       =~ s/($ME)//s;
$title     = "ftp$urlc";
$url       = "$urlc\0";

# Frendly starter for the html server & HEADER.html output:
top_html($HEADER,$title);

$t00 = new Benchmark;
# Open discription file   

# 00index.txt format reader
if (@ar=stat $DESCRIPTION ){
    open(FH,$DESCRIPTION);
    read(FH,$indx,$ar[7],$offset);
    close(FH); 
    @indexa=split(/\n/,$indx);
    sort(@indexa); 
    foreach $ding (@indexa){
	$ding=~ m/(\S+)(\s+)(.*)/;
    push(@indexf,$1);               # Item name
    push(@indexd,$3);               # Description of item
    }
} elsif (@ar=stat $DESCRIPTION2) {

#.htaccess file reader
    open(FH,$DESCRIPTION2);
    read(FH,$indx,$ar[7],$offset);
    close(FH); 
    @indexa=split(/\n/,$indx);
    sort(@indexa); 
    foreach $ding (@indexa){
	$ding=~ m/(\S+)(\s+)(\")(.*)(\")(\s+)(.*)/;
    push(@indexf,$7);               # Item name
    push(@indexd,$4);               # Description of item
    }
}

#Open our main directory and read it
opendir( DH,$thisdir)|| die("ERROR: Could not open $thisdir");
@fulldir=readdir(DH);
closedir(DH);
sort @fulldir;
# need a better way for this in a one comand :-)
shift @fulldir ;shift @fulldir;		
$wehave=join(' ',@indexf);

foreach $ding (@fulldir) {
    $test=quotemeta($ding);
    if ($wehave!~ s/(\s*)($test)//s) {
       	if (($ding!~ m/($SKIPDIRS)(\s*)/o) || ($ding!~ m/($SKIPFILES)/o)) {
      	    push(@indexf,$ding);               # Item name
	    push(@indexd," ");              # Description of item	
	    print STDERR "WARNING: File '$ding' is not described in ";
            print STDERR "$DESCRIPTION\n";
	}
    }

}

print STDERR "WARNING:'$wehave' are described in $DESCRIBE but not in $title\n"  if (length($wehave)); 

# Now scan the item type

foreach $file (@indexf) {
	if (-d $file) {push(@indext,$DIR_ICON);
		       push(@indexu,"$file");}
	    elsif (-T $file) {push(@indext,$TXT_ICON);
			      push(@indexu,"ftp$urlc$file");}
                elsif (-B $file) {push(@indext,$DIST_ICON);
				  $go="ftp$urlc$file";
			          push(@indexu,"$go");}
	           else {print STDERR "WARNING: The file description file";
		       print STDERR " $DESCRIPTION contains a unaccesable";
		       print STDERR " entry:$file\n";
		       push(@indext,$BROKE_ICON);
		       push(@indexu,"$file"); 
		     }
	@ar=stat($file);$size=int(10*$ar[7]/1024)/10;
	if (($ar[7]==0)||($indext[$#indext] eq $DIR_ICON)) {$size="-";} 
	else {$size="$size kb";}
        push(@indexs,$size);
    }
$t1 = new Benchmark;
$td = timediff($t1, $t00);
print FDd ">>index, full dir read & sort. took:",timestr($td),"\n";

# Yheeeaaaaa let's produce the bugger
# Place all the dirs first
$e=scalar(@indexf);
for($i=0;$i<$e;$i++){
    file_line($indext[$i],$indexu[$i],$indexf[$i],$indexs[$i],$indexd[$i]);
} 

print STDOUT "</TABLE>";

# Close output document
dumpfile($FOOTER);
print STDOUT $COPRIGHT;

$t1 = new Benchmark;
$td = timediff($t1, $t0);
print STDOUT "<H5><pre>CPU Usages processing this list:",timestr($td),"</pre></H6>";
close (STDERR);close(STDOUT);

print FDd ">>The Complete code took:",timestr($td),"\n";
clode(FDd);

# -----------------------------    Subroutines   -----------------------------
# Build top of document
sub top_html{
    local ($file,$title)=@_;
    local ($dir);
    print STDOUT "Content-type: text/html\n\n";
    print STDOUT "<META HTTP-EQUIV=\"Expires\" CONTENT=";
    printf STDOUT "\"$EXPIRE\">\n";
    print STDOUT "<HEAD>\n\n";
    print STDOUT "<!---           HTML Code generated by         -->\n";
    print STDOUT "<!---               FTPzuiger $VERSION              -->\n";
    print STDOUT "<!---                                          -->\n";
    print STDOUT "<!---  Written by Wessel de Roode Jan-14-1997  -->\n\n";
    print STDOUT "<TITLE>$title</TITLE>\n</HEAD>\n";
    dumpfile($file);
    print STDOUT "<TABLE BORDER=$BORDERS CELLPADDING=2 CELLSPACING=0>";
    print STDOUT "<TH><IMG SRC=\"$BLANK_ICON\" ALT=\"     \"></TH>";
    print STDOUT "<TH>File</TH><TH>Size:</TH><TD> </TD><TH>Description</TH>";
    $burl=$url;
    @tmpp=split('/',$burl);
    $tmp=@tmpp[(scalar @tmpp)-2];
    $burl=~ s/($tmp)(\/)//;

    print STDOUT "<TR><TD><A HREF=\"http$burl\">";
    print STDOUT "<IMG SRC=\"$BACK_ICON\" ALT=\"[DIR]\" BORDER=0></TD>";
    print STDOUT "<TD><A HREF=\"http$burl\">Parent Directory</A></TD>";
    print STDOUT "<TD ALIGN=right>-  </TD><TD></TD><TD> $discript</TD></TR>";
}

sub file_line {
    local ($icon,,$url,$file,$size,$discr)=@_;
    $cfile=$file;
    $cfile=~s/($FILE_EXT)//s;

    print STDOUT "<TR><TD><A HREF=\"$url\">";
    print STDOUT "<IMG SRC=\"$icon\" WIDTH=$WIDTH HEIGHT=$HEIGHT ";
    print STDOUT "BORDER=0 ALT=\"[   ]\"></A></TD>"; # Hier textinvul mogelijkheid
    print STDOUT "<TD><A HREF=\"$url\">$cfile</A></TD>";
    print STDOUT "<TD ALIGN=right>$size</TD><TD></TD><TD> $discr</TD></TR>";
}

# Just cat a file $file to stndout
sub dumpfile {
    local ($file)=@_;
    local ($top)="\0";
    if (@ar=stat($file)) {
	open(FH,$file);
	read(FH,$top,$ar[7],$offset);
	print STDOUT $top;
	close(FH);
    } else {print STDERR "WARNING: Can't find file $file\n";}  
}