--- /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/
--- /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>
--- /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>
--- /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
--- 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>
--- /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
--- 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"
+ ),
+ " © 2010,2011 ",
+ a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann"),
+ " © 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"
- ),
- " © 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;
+}