#!/usr/bin/perl -T

use strict ;
use warnings ;

use CGI ':standard' ;
use Archive::Tar ;
use POSIX ;
use File::Path ;
use Fcntl ':flock' ;

my $NAMEWIDTH  = 23 ;
my $MTIMEWIDTH = 17 ;
my $SIZEWIDTH  = 6  ;

my $tardir = '/home/www/htdocs/slackpack' ;
my $tmpdir = '/home/www/tmp/tarpeek' ;

my $url = url() ;
my $path_info = path_info() ;

my (undef, $file, $subfile) = split(/\/+/,$path_info,3) ;
my $dir = '' ;
while ($subfile and -d "$tardir/$dir$file") {
    $dir = "$dir$file/" ;
    ($file, $subfile) = split(/\/+/,$subfile,2) ;
}

if (!$subfile and $path_info !~ m!/$!) {

    print redirect("$url$path_info/") ;
    exit ;
}

$subfile ||= '' ;

if (!$subfile or $subfile =~ /\/$/) {

    print header('text/html') ;

    print start_html("Index of $path_info") ;

    print h1("Index of $path_info") ;

    print '<pre>' ;
    printf "%s %-${NAMEWIDTH}s %-${MTIMEWIDTH}s %${SIZEWIDTH}s\n", 
	img({-src=>'/icons/blank.gif', -border=>0}),
	'Name',
	'Last modified',
	'Size' ;
    print hr() ;
    print a({-href=>'..'},[img({-src=>'/icons/back.gif', -border=>0}),'Parent directory'])."\n" if $subfile ;

    my @tarfiles =
	sort {
	    $b->{name} =~ m!/$! <=> $a->{name} =~ m!/$!
		||
	    $a->{name} cmp $b->{name}
	} grep { $_->{name} =~ m!^\Q$subfile\E[^/]+/?$! } list_archive("$dir$file") ;

    foreach my $tarfile (@tarfiles) {
	my $size  = $tarfile->{size} ;
	$size = $size ? sprintf '%dk', ($size>>10) : '-' ;
	my $mtime = $tarfile->{mtime} ;
	my $filename = $tarfile->{name} ;
	next if $filename eq './' ;

	$filename =~ m!^\Q$subfile\E([^/]+/?)$! and $filename = $1 ;
	my $displayname = $filename ;
	substr($displayname, ($NAMEWIDTH - 2)) = '..>' if (length($displayname) > $NAMEWIDTH) ;

	my $icon = '/icons/unknown.gif' ;
	if ($filename =~ m!/$!) {
	    $icon = '/icons/folder.gif' ;
	} elsif ($filename =~ /(?:\.html?|\.te?xt)/) {
	    $icon = '/icons/text.gif' ;    
	}
	printf "%s <a href='%s'>%s</a>%s %s %${SIZEWIDTH}s\n",
	    img({-src=>$icon, -border=>0}),
	    $filename,
	    $displayname,
	    ' 'x($NAMEWIDTH - length $displayname),
	    strftime('%d-%b-%Y %R', localtime $mtime),
	    $size;
    }
    print '</pre>' ;
    print hr() ;
    print end_html() ;

} else {

    my $tar = Archive::Tar->new("$tardir/$dir$file") ;
    my $content = $tar->get_content($subfile) ;
    print $content ? (header('*/*'),$content) : (redirect("$url$path_info/")) ;
}

sub list_archive {
    my $tarfile = shift ;
    $tarfile =~ s!\.\.!!g ;
    if ($tarfile =~ m!((?:[^/]*/?)*)!) {
	$tarfile = $1 ;
    } else {
	die ;
    }

    my @tarcontents = () ;

    mkpath($1,0,0755) if "$tmpdir/$tarfile" =~ m!(.*/)! ;

    my $tarfile_mtime = (stat "$tardir/$tarfile")[9] || 0 ;
    my $tmpfile_mtime = (stat "$tmpdir/$tarfile")[9] || 0 ;

    if ($tarfile_mtime > $tmpfile_mtime) {
	@tarcontents = Archive::Tar->list_archive("$tardir/$tarfile",[ 'name','mtime','size' ] ) ;
    
	open TARCONTENTS, '>', "$tmpdir/$tarfile" or return @tarcontents ;
	flock TARCONTENTS, LOCK_EX ;
	foreach my $tar (@tarcontents) {
	    print TARCONTENTS "$tar->{name} $tar->{mtime} $tar->{size}\n" ;
	}
	flock TARCONTENTS, LOCK_UN ;
	close TARCONTENTS ;
    } else {
	open TARCONTENTS, '<', "$tmpdir/$tarfile" or return Archive::Tar->list_archive("$tardir/$tarfile",[ 'name','mtime','size' ] ) ;
	flock TARCONTENTS, LOCK_SH ;
	while (<TARCONTENTS>) {
	    my %tar = () ;
	    ($tar{name}, $tar{mtime}, $tar{size}) = /^(.*) (\d+) (\d+)$/ ;
	    push @tarcontents, \%tar ;
	}
	flock TARCONTENTS, LOCK_UN ;
	close TARCONTENTS ;
    }
    
    return @tarcontents ;

}