# HG changeset patch # User Heiko Schlittermann # Date 1253223183 -7200 # Node ID 6d8dea55365acbe7c0c2d1c77771cceedf15c27a initial version diff -r 000000000000 -r 6d8dea55365a upload.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/upload.pl Thu Sep 17 23:33:03 2009 +0200 @@ -0,0 +1,96 @@ +#! /usr/bin/perl -T +# Example .htaccess +# | +# | AuthType Basic +# | AuthName upload +# | Require valid-user +# | AuthUserFile /home/heiko/public_html/.passwd +# | + +use strict; +use warnings; +use CGI qw(:all *table); +use CGI::Carp qw(fatalsToBrowser); +use CGI::Pretty; +use IO::File; +use File::Basename; +use Digest::SHA1 qw(sha1_hex); + +my $DIR = "upload.d"; +my $LINK_DIR = url(-base => 1) . dirname($ENV{SCRIPT_NAME}) . "/$DIR"; + +-d $DIR + or mkdir $DIR => 0750 + or die "Can't mkdir $DIR: $!\n"; + +MAIN: { + print header(-charset => "UTF-8"), start_html, + h1 "View: $ENV{REMOTE_USER}"; + + # print Dump; + + if (param("delete") =~ /([a-z\d]+-\d+)/i) { + my $dir = $1; + if (-d "$DIR/$dir") { + unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*") + or die "Can't unlink $DIR/$dir/*: $!\n"; + rmdir "$DIR/$dir" or die "Can't rmdir $DIR/$dir: $!\n"; + } + } + + if (length(my $file = param("upload"))) { + my $expires = param("expires"); + + # sanitize expires + $expires =~ /.*?(\d+).*/; + $expires = time + (defined $1 ? $1 : 10) * 86400; + + # sanitizing the filename + (my $filename = $file) =~ tr /\\/\//; + $filename =~ /(.*)/; + $filename = $1; + + my $dir = "$DIR/" . sha1_hex(time + rand(10_000)) . "-$expires"; + mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; + my $outfh = new IO::File ">$dir/$filename" + or die "Can't create $dir/$filename: $!\n"; + print {$outfh} <$file>; + } + print hr; + + print start_table, Tr(th { align => "left" }, [qw/name size date expires/]); + + foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") { + my ($file, $dir) = fileparse($_); + $dir = basename $dir; + $dir =~ /(?\S+)-(?\d+)$/ or next; + if ($+{expires} <= time) { + /(.*)/; + unlink $_ or die "Can't unlik $_: $!\n"; + rmdir $dir or die "Can't rmdir $dir: $!\n"; + next; + } + + print Tr( + td(a { href => "$LINK_DIR/$dir/$file" }, $file), + td({ align => "right" }, (stat $_)[7]), + td(scalar localtime +(stat $_)[9]), + td(scalar localtime $+{expires}), + td(a({ href => "?delete=$dir" }, "remove")) + ); + } + + print end_table, hr; + + print start_multipart_form, start_table, + Tr(td("Dateiname: "), + td(filefield(-name => "upload", -default => "nothing")), + ), + Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)), + td("Tagen")), + Tr(td(), td(submit(-value => "Hochladen")),), + end_table, + end_multipart_form; + + print end_html; +}