# HG changeset patch
# User Matthias Förste <foerste@schlittermann.de>
# Date 1412257724 -7200
# Node ID b136280295a2a0f99fbc115f3d015cf98974353b
# Parent  c1e9c225237b4b334cd69b05baf33a48673205cb
2 more upload removal options (on first download / only manually)

diff -r c1e9c225237b -r b136280295a2 upload.pl
--- 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);