--- a/upload.pl Mon Aug 01 16:22:12 2011 +0200
+++ b/upload.pl Thu Oct 02 15:48:44 2014 +0200
@@ -28,13 +28,16 @@
use CGI::Pretty;
use IO::File;
use File::Basename;
+use File::MimeInfo qw(mimetype);
+use Cwd qw(getcwd realpath);
use Digest::MD5 qw(md5_hex);
use OSSP::uuid;
-my $DIR = "d/{view}";
+my $DIR = "d";
my $DIR_URI = "/xfer/$DIR";
sub human($);
+sub deletedir(@);
delete @ENV{ grep /PATH/, keys %ENV };
$ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin";
@@ -45,23 +48,44 @@
MAIN: {
+ # assuming download request
+ if (request_uri =~ m|^\Q$DIR_URI\E/(.+)$|) {
+ # assuming $DIR relative to cwd
+ my $relative = $1;
+ my $base = getcwd;
+ my $absolute;
+ unless ($absolute = realpath "$base/$DIR/$relative") {
+ die "Can't realpath '$base/$DIR/$relative': $!" unless exists $!{ENOENT} and $!{ENOENT};
+ print header('text/plain', '404 Not found');
+ print "Not found";
+ exit 0;
+ }
+ $absolute =~ m|^\Q$base/$DIR\E| or die "invalid path: [$absolute]";
+
+ open F, '<', $absolute or die "Can't open '<', '$absolute': $!";
+ print header(-type => mimetype($absolute));
+ my ($buf, $res);
+ print $buf while $res = read F, $buf, 32*2**10;
+ defined $res or die "Can't read: $!";
+
+ (my $dir = $relative) =~ s|/[^/]+$||;
+ deletedir $dir if $dir =~ /-d$/;
+ exit 0;
+
+ }
+
# per view we have an own directory
$ENV{REMOTE_USER} =~ /(.*)/;
$_ = md5_hex($1);
- $DIR =~ s/{view}/$_/g;
- $DIR_URI =~ s/{view}/$_/g;
+ $DIR .= "/$_";
+ $DIR_URI .= "/$_";
-d $DIR
or mkdir $DIR => 0750
or die "Can't mkdir $DIR: $!\n";
- 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 (param("delete") =~ /([-a-z\d]+-\d+-.)/i) {
+ deletedir $1;
print redirect(-uri => url(-path_info => 1));
exit 0;
}
@@ -74,20 +98,27 @@
if (length(my $file = param("upload"))) {
my $days = param("expires");
- my $expires;
+ my ($delete, $expires);
tie my $uuid => "OSSP::uuid::tie", "v4";
# sanitize expires
- $days =~ /.*?(\d+).*/;
+ $days =~ /.*?([+-]?\d+).*/;
$days = defined $1 ? $1 : 10;
+
$expires = time + $days * 86400;
+ $delete = 'l'; # on file[l]ist
+ if ($days == 0) {
+ $delete = 'd'; # on first [d]ownload
+ } elsif ($days == -1) {
+ $delete = 'm'; # only [m]anually
+ }
# sanitizing the filename
(my $filename = $file) =~ tr /\\/\//;
$filename =~ /(.*)/;
$filename = $1;
- my $dir = "$DIR/$uuid-$expires";
+ my $dir = "$DIR/$uuid-$expires-$delete";
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";
@@ -125,10 +156,9 @@
$dir = basename $dir;
# $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
- $dir =~ /(\S+)-(\d+)$/ or next;
- my $hash = $1;
- my $expires = $2;
- if (${expires} <= time) {
+ $dir =~ /(\S+)-(\d+)-(.)$/ or next;
+ my ($hash, $expires, $delete) = ($1, $2, $3);
+ if (${expires} <= time and $delete eq 'l') {
/(.*)/;
unlink $_ or die "Can't unlik $_: $!\n";
rmdir $dir or die "Can't rmdir $dir: $!\n";
@@ -139,7 +169,7 @@
td(a { href => "$DIR_URI/$dir/$file" }, $file),
td({ align => "right" }, human((stat $_)[7])),
td(scalar localtime +(stat $_)[9]),
- td(scalar localtime ${expires}),
+ td($delete eq 'l' ? scalar localtime ${expires} : 'nicht verfügbar'),
td(a({ href => "?delete=$dir" }, "remove"))
);
}
@@ -152,7 +182,7 @@
td(filefield(-name => "upload", -default => "nothing")),
),
Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)),
- td("Tagen")),
+ td("Tagen (0: beim ersten Download; -1: nur manuell)")),
Tr(td(), td(submit(-value => "Hochladen")),),
end_table,
end_multipart_form;
@@ -170,6 +200,16 @@
end_html;
}
+sub deletedir(@) {
+ for my $dir (@_) {
+ 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";
+ }
+ }
+}
+
sub human($) {
my $_ = shift;
my @units = qw(B K M G T);