# HG changeset patch
# User Matthias Förste <foerste@schlittermann.de>
# Date 1417095288 -3600
# Node ID a9b52c555cd1ef2d96b73643e501b8288498ec64
# Parent  1800d3b7d5a6e68f61e4e9acf758e833dd9bc34c
download of one time urls requires confirmation to avoid accidental removal (by virus scanners for example); reusable footer

diff -r 1800d3b7d5a6 -r a9b52c555cd1 upload.pl
--- a/upload.pl	Tue Oct 07 12:11:14 2014 +0200
+++ b/upload.pl	Thu Nov 27 14:34:48 2014 +0100
@@ -38,6 +38,7 @@
 
 sub human($);
 sub deletedir(@);
+sub confirm;
 
 delete @ENV{ grep /PATH/, keys %ENV };
 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin";
@@ -46,6 +47,19 @@
 -d or mkdir $_ => 0750
   or die "Can't mkdir $_: $!\n";
 
+my @footer = (hr,
+      div(
+        { -align => "right" },
+        a(
+            { -href => "https://ssl.schlittermann.de/hg/anon-upload/file/once/" } =>
+                          "Scripting"
+        ),
+        " &copy; 2010,2011 ",
+        a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann"),
+        " &copy; 2014 ",
+        a({ -href => "http://www.schlittermann.de/" } => "Matthias Förste")
+      ));
+
 MAIN: {
 
     # assuming download request
@@ -58,12 +72,16 @@
         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";
+            print header('text/plain', '404 Not found'), 'Not found';
             exit 0;
         }
         $absolute =~ m|^\Q$base/$DIR\E| or die "invalid path: [$absolute]";
 
+        (my $dir = $relative) =~ s|/[^/]+$||;
+        my $delete = $dir =~ /-d$/;
+
+        confirm if ($delete and not defined param('confirmed'));
+
         open F, '<', $absolute or die "Can't open '<', '$absolute': $!";
         print header(-type => mimetype($absolute), -charset => 'UTF-8');
         if (request_method() ~~ [qw(GET POST)]) {
@@ -71,8 +89,7 @@
             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$/;
+            deletedir $dir if $delete;
         }
         exit 0;
 
@@ -203,20 +220,8 @@
       ),
       Tr(td(), td(submit(-value => "Hochladen")),),
       end_table,
-      end_multipart_form;
-
-    print hr,
-      div(
-        { -align => "right" },
-        a(
-            { -href => "https://ssl.schlittermann.de/hg/anon-upload/file/once/" } =>
-                          "Scripting"
-        ),
-        " &copy; 2010,2011 ",
-        a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann"),
-        " &copy; 2014 ",
-        a({ -href => "http://www.schlittermann.de/" } => "Matthias Förste")
-      ),
+      end_multipart_form, 
+      @footer,
       end_html;
 }
 
@@ -241,3 +246,18 @@
       if !@units;
     return "$_$units[0]";
 }
+
+sub confirm {
+    print header(-charset => "UTF-8"),
+      start_html(-title => "once"),
+      h1 "Download bestätigen";
+      print hr,
+      p <<__;
+        Die Datei die Sie herunterladen möchten wird nach Abschluß des
+        Downloads gelöscht. Um zu verhindern, daß Virenscanner oder andere
+        Programme die diesen Link automatisiert aufrufen die Löschung der Datei
+        auslösen bestätigen Sie bitte den Download per Knopfdruck.
+__
+    print start_form, hidden('confirmed', 'yes'), submit(-value => 'Bestätigung'), end_form, @footer, end_html;
+    exit 0;
+}