--- a/upload.pl Tue Oct 07 10:54:29 2014 +0200
+++ b/upload.pl Tue Oct 07 10:58:02 2014 +0200
@@ -48,40 +48,42 @@
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]";
+ # assuming download request
+ if (request_uri =~ m|^\Q$DIR_URI\E/(.+)$|) {
- open F, '<', $absolute or die "Can't open '<', '$absolute': $!";
- print header(-type => mimetype($absolute));
- if (request_method() ~~ [qw(GET POST)]) {
- my ($buf, $res);
- print $buf while $res = read F, $buf, 32*2**10;
- defined $res or die "Can't read: $!";
+ # 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]";
- (my $dir = $relative) =~ s|/[^/]+$||;
- deletedir $dir if $dir =~ /-d$/;
- }
- exit 0;
+ open F, '<', $absolute or die "Can't open '<', '$absolute': $!";
+ print header(-type => mimetype($absolute));
+ if (request_method() ~~ [qw(GET POST)]) {
+ 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 .= "/$_";
- $DIR_URI .= "/$_";
+ $DIR .= "/$_";
+ $DIR_URI .= "/$_";
-d $DIR
or mkdir $DIR => 0750
or die "Can't mkdir $DIR: $!\n";
@@ -108,12 +110,12 @@
$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
- }
+ $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 /\\/\//;
@@ -126,7 +128,9 @@
or die "Can't create $dir/$filename: $!\n";
print {$outfh} <$file>;
- if (not $delete ~~ [qw(d m)] and my $atfh = new IO::File("|at now + $days days")) {
+ if (not $delete ~~ [qw(d m)]
+ and my $atfh = new IO::File("|at now + $days days"))
+ {
print {$atfh}
"rm -f \"$dir/$filename\"\n",
"rmdir \"$dir\"\n";
@@ -192,8 +196,11 @@
Tr(td("Dateiname: "),
td(filefield(-name => "upload", -default => "nothing")),
),
- Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 0)),
- td("Tagen (0: unmittelbar nach Download; -1: nur manuell)")),
+ Tr(
+ td("Löschen in: "),
+ td(textfield(-name => "expires", -default => 0)),
+ td("Tagen (0: unmittelbar nach Download; -1: nur manuell)")
+ ),
Tr(td(), td(submit(-value => "Hochladen")),),
end_table,
end_multipart_form;
@@ -212,13 +219,13 @@
}
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";
- }
- }
+ 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($) {