# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1448038960 -3600
# Node ID 29784b9008466895c94e32bf813be6eee7069bc8
# Parent  c1e9c225237b4b334cd69b05baf33a48673205cb# Parent  15f109d06ec0b964cc498e5db158d5a6193dda59
[merged] from branch once

diff -r c1e9c225237b -r 29784b900846 .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Fri Nov 20 18:02:40 2015 +0100
@@ -0,0 +1,2 @@
+.htaccess
+d/
diff -r c1e9c225237b -r 29784b900846 apache.conf
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/apache.conf	Fri Nov 20 18:02:40 2015 +0100
@@ -0,0 +1,14 @@
+    <Location "/once">
+        SetHandler once-upload-handler
+        Action once-upload-handler /once-handler/upload.pl virtual
+    </Location>
+
+    <Directory "$DOCUMENTROOT/once-handler">
+        AllowOverride AuthConfig Limit Options
+        AddHandler cgi-script .pl
+    </Directory>
+
+    <Location "/once/d">
+        SetHandler once-download-handler
+        Action once-download-handler /once-handler/download.pl virtual
+    </Location>
diff -r c1e9c225237b -r 29784b900846 d/dot.htaccess
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/d/dot.htaccess	Fri Nov 20 18:02:40 2015 +0100
@@ -0,0 +1,6 @@
+# needs AllowOverride AuthConfig Options
+Options None Indexes ExecCGI FollowSymlinks
+<Files "*">
+    Order allow,deny
+    allow from 127.0.0.1
+</Files>
diff -r c1e9c225237b -r 29784b900846 debdeps.control
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/debdeps.control	Fri Nov 20 18:02:40 2015 +0100
@@ -0,0 +1,12 @@
+#!/usr/bin/equivs-build
+Section: web
+Priority: optional
+Homepage: https://ssl.schlittermann.de/hg/anon-upload/file/once
+Standards-Version: 3.9.2
+# grep -io '^use [^; ]*' upload.pl |while read x m; do dh-make-perl locate $m; done 2>&1|grep -Ev '^Using cached Contents'|sed 's/^.* is in //'|sed 's/ since [0-9.]\+$//' |sort -u
+Depends: perl, libfile-mimeinfo-perl, libossp-uuid-perl
+Package: ius-once-deps
+Version: 1.0
+Description: dependencies for 'once'
+ 'once' is our 'one time download' skript; this package installs its
+ dependencies
diff -r c1e9c225237b -r 29784b900846 dot.htaccess
--- a/dot.htaccess	Mon Aug 01 16:22:12 2011 +0200
+++ b/dot.htaccess	Fri Nov 20 18:02:40 2015 +0100
@@ -1,8 +1,17 @@
 # needs AllowOverride AuthConfig Options
-Options -Indexes
-<Files ~ "^(upload\.pl|^\.ht)">
-	AuthType Basic
-	AuthName upload
-	Require valid-user
-	AuthUserFile <place your htpasswd file path here>
+Options None Indexes ExecCGI FollowSymlinks
+<Files "*">
+    Order deny,allow
+    deny from all
+    satisfy all
 </Files>
+<Files "upload.pl">
+    AuthType Basic
+    AuthName upload
+    Require valid-user
+    AuthUserFile <FOO>/htpasswd
+    Order allow,deny
+</Files>
+<Files "download.pl">
+    Order allow,deny
+</Files>
diff -r c1e9c225237b -r 29784b900846 download.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/download.pl	Fri Nov 20 18:02:40 2015 +0100
@@ -0,0 +1,1 @@
+upload.pl
\ No newline at end of file
diff -r c1e9c225237b -r 29784b900846 upload.pl
--- a/upload.pl	Mon Aug 01 16:22:12 2011 +0200
+++ b/upload.pl	Fri Nov 20 18:02:40 2015 +0100
@@ -20,7 +20,7 @@
 #   Alias	/d	    /home/ud/XXX/d/
 # gesetzt werden.
 
-use 5.010;
+use 5.014;
 use strict;
 use warnings;
 use CGI qw(:all *table);
@@ -28,13 +28,17 @@
 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_URI = "/xfer/$DIR";
+my $DIR     = "d";
+my $DIR_URI = "/once/$DIR";
 
 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";
@@ -43,57 +47,110 @@
 -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
+    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'), '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)]) {
+            my ($buf, $res);
+            print $buf while $res = read F, $buf, 32 * 2**10;
+            defined $res or die "Can't read: $!";
+
+            deletedir $dir if $delete;
+        }
+        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;
     }
 
     print header(-charset => "UTF-8"),
-      start_html(-title => "Up&Down"),
+      start_html(-title => "once"),
       h1 "Ansicht: $ENV{REMOTE_USER}";
 
     # print Dump;
 
     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";
         print {$outfh} <$file>;
 
-        if (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";
@@ -125,21 +182,29 @@
             $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";
                 next;
             }
 
+            my $d;
+            if ($delete eq 'l') {
+                $d = localtime ${expires};
+            } elsif ($delete eq 'd') {
+                $d = 'unmittelbar nach Download';
+            } else {
+                $d = 'nur manuell';
+            }
+
             print Tr(
                 td(a { href => "$DIR_URI/$dir/$file" }, $file),
                 td({ align => "right" }, human((stat $_)[7])),
                 td(scalar localtime +(stat $_)[9]),
-                td(scalar localtime ${expires}),
+                td($d),
                 td(a({ href => "?delete=$dir" }, "remove"))
             );
         }
@@ -151,23 +216,26 @@
       Tr(td("Dateiname: "),
         td(filefield(-name => "upload", -default => "nothing")),
       ),
-      Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)),
-        td("Tagen")),
+      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;
+      end_multipart_form,
+      @footer,
+      end_html;
+}
 
-    print hr,
-      div(
-        { -align => "right" },
-        a(
-            { -href => "https://keller.schlittermann.de/hg/anon-upload/" } =>
-              "Scripting"
-        ),
-        " &copy; 2010,2011 ",
-        a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann")
-      ),
-      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($) {
@@ -177,7 +245,27 @@
         $_ = sprintf "%.1f" => $_ / 1024;
         shift @units;
     }
-    croak "filesize is too big (can't convert to human readable number"
+    croak "filesize is too big (can't convert to human readable number)"
       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. Virenscanner oder andere Programme, die den Link
+        möglicherweise automatisiert aufrufen, könnten eine versehentliche
+        Löschung der Datei auslösen. Bestätigen Sie deshalb bitte den Download
+        per Knopfdruck.
+__
+    print start_form,
+        hidden('confirmed', 'yes'),
+        submit(-value => 'Bestätigung'),
+        end_form,
+        @footer,
+        end_html;
+    exit 0;
+}