# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1451916120 -3600
# Node ID b0f2dfaa34ac3608a392d47b8f6a73fd518fac62
# Parent  77cdbbde04aed76eb9189b6b0ad89c4e46c93856# Parent  a4a87929803f6a5751aa174d5f002d75ef2bdaec
[merge] from old revision

diff -r a4a87929803f -r b0f2dfaa34ac .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,8 @@
+^.htaccess
+^templates.var/version.tt
+^blib/
+^Build$
+^_build/
+^MYMETA.json$
+^MYMETA.yml$
+^templates/version\.tt$
diff -r a4a87929803f -r b0f2dfaa34ac Build.PL
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Build.PL	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,18 @@
+use Module::Build;
+
+Module::Build->new(
+    dist_name => 'once',
+    dist_version_from => 'lib/Once.pm',
+    dist_abstract => 'once downloader',
+    script_files => [qw(bin/once)],
+    share_dir => [qw(templates)],
+    PL_files => {
+	'lib/version.PL' => 'templates/version.tt',
+    },
+    requires => {
+	'perl' => '5.0.18',
+        'File::MimeInfo' => 0,
+	'Template' => 0,
+	'experimental' => 0,
+    },
+)->create_build_script;
diff -r a4a87929803f -r b0f2dfaa34ac bin/once
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/once	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,389 @@
+#! /usr/bin/perl -T
+# FIXME: UPDATE {{
+# Example .htaccess
+# | Options -Indexes
+# | <Files once.pl>
+# | AuthType Basic
+# | AuthName upload
+# | Require valid-user
+# | AuthUserFile /home/heiko/public_html/.passwd
+# | </Files>
+#
+# Je nach Permission-Lage kann es gut sein, daß das upload.d-Verzeichnis
+# mit der Hand angelegt werden muß und dem Webserver-Nutzer „geschenkt“
+# werden muß.
+#
+# Das Upload-Verzeichnis sollte natuerlich vor der Indizierung geschuetzt
+# werden - siehe Beispiel .htaccess.
+#
+# Eventuell in der Apache-Config sowas wie
+#   ScriptAlias /ud	    /home/ud/XXX/once.pl
+#   Alias	/d	    /home/ud/XXX/d/
+# gesetzt werden.
+#
+# }}
+#
+#
+# Directory Structure
+# $VAR/ (from ONCE_VAR environment)
+#     $userdir/
+#              $uuid1-$timestamp-$removal_hint/$uploaded-file1
+#              $uuid2-$timestamp-$removal_hint/$uploaded-file1
+
+
+# TODO: Security review!
+
+use 5.018;
+use strict;
+use warnings;
+use IO::File;
+use CGI qw(param upload header request_method url redirect);
+use CGI::Carp qw(fatalsToBrowser);
+use FindBin qw($RealBin $Bin);
+use File::Basename;
+use File::Path qw(remove_tree make_path);
+use File::Spec::Functions;
+use File::ShareDir qw(dist_dir);
+use File::MimeInfo qw(mimetype);
+use Cwd qw(getcwd realpath);
+use Digest::MD5 qw(md5_hex md5);
+use Template;
+use experimental qw(smartmatch lexical_topic);
+
+my $DIST = basename $0, '.pl';
+
+sub humanize;     # convert numbers to human readable format
+sub deletedir;    # safely delete directories
+sub confirm;      # ask for user confirmation (HTML)
+sub deslash;      # cleanup a path name
+sub gen_uuid;     # create a uniq identifier
+sub base62;
+sub md5_base62 { ... }
+sub untaint;
+
+# These to RX are used in several places. Do not change them. It's
+# important that they do not include the ../ sequence (not even URL
+# encoded!)
+my $rxVIEW = qr/[a-z\d]{6}-[a-z\d]+/i;          # date-userhash
+my $rxFILE = qr/[a-z\d]{6}-[a-z\d]+-[dme]/i;    # date-filehash-removalmode
+
+my %TT_CONFIG = (
+#  PROCESS => 'version.tt',
+  INCLUDE_PATH =>
+      [ (map { catfile($Bin, $_) } qw(templates templates.default) ),
+	#(map { catfile(dist_dir($DIST), $_) } qw(var templates.override templates)),
+	(map { catfile($RealBin, $_) } qw(templates)),
+      ]
+);
+
+umask 077;
+
+# The working (var) directory gets passed to us via ONCE_VAR environment
+# FIXME: Should we allow the current directory as an alternative?
+
+die "Environment ONCE_VAR needs to be defined\n"
+  if not defined $ENV{ONCE_VAR};
+my $VAR = untaint($ENV{ONCE_VAR}, qr((^/.*)));
+
+exit main() if not caller;
+
+sub main {
+
+    # Handle the UPLOAD / VIEW request
+    # per view (user) we have an own directory
+
+    # Preconditions: $VAR needs to exist (it's the base directory
+    # for all R/W operations
+    -d $VAR
+      or mkdir $VAR => 0777
+      or die "Can't mkdir $VAR: $! (Your admin should have created it. (uid:$> gids:$)))\n";
+
+    -x -w $VAR
+      or die "Can't write to $VAR: $!\n";
+
+    # Check if the PATH_INFO looks like a download request.
+    # If so, we're done.
+    handle_download($ENV{PATH_INFO})
+      and exit 0;
+
+    handle_removal(param('delete'))
+        and exit 0;
+
+    # Setup the essentials: view and user_dir
+    my ($view, $user_dir) = do {
+
+        # view: display name
+        #       anonymous | hans | …
+        # user_dir: the directory name, per view/user
+        #
+        # NOTE: if you change the generated user_dir string here, you may need
+        # to adapt the patterns $rxVIEW and $rxFILE at the beginning of
+        # the script.
+        #
+        my ($v, $d);
+        my $remote_user = defined $ENV{REMOTE_USER}
+            ? untaint $ENV{REMOTE_USER}, qr/(\w+)/
+            : 'anonymous';
+        $d = join '-' => base62(time), $remote_user;
+        $v = $remote_user;
+        $v, deslash catfile($VAR, $d);
+    };
+
+    # save the uploaded file
+
+    if (length(my $file = param('upload'))) {
+        my $upload_fh = upload('upload');
+        my $uuid      = gen_uuid();
+        my ($delete, $expires, $days) = do {
+            my ($d, $e);
+            my $days = param('expires') // 0;
+
+            # sanitize expires
+            $days =~ /.*?([+-]?\d+).*/;
+            $days = $1 // 10;
+            $e = base62 time + $days * 86400;
+
+            if    ($days == 0) { $d = 'd' }    # at first [d]ownload
+            elsif ($days < 0)  { $d = 'm' }    # only [m]anually
+            else               { $d = 'e' }    # if expired
+            ($d, $e, $days);
+        };
+
+        # sanitize the filename
+        my $filename = do {
+	# FIXME: should we allow backslashes in filenames? It's totally legal for *nix,
+	# but may confuse win* users, for now we play safe and convert \ to _
+	# OTOH, then we should convert other problematic chars too.
+            $file =~ tr /\\/\//;	# convert \ to /
+	    $file =~ s/.*\///;          # poor man's basename
+            $file =~ /(.*)/;
+            $1;
+        };
+
+        my $dir = catfile($user_dir, "$expires-$uuid-$delete");
+        make_path($dir);
+        {
+            my $outfh = new IO::File "$dir/$filename", 'w'
+              or die "Can't create $dir/$filename: $!\n";
+            print {$outfh} <$upload_fh>;
+        }
+
+        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";
+            close $atfh;
+        }
+
+    }
+
+    # create the view
+    my %tt = (view => $view);
+    my $tt = Template->new(\%TT_CONFIG)
+      or die $Template::ERROR;
+
+    # List the current content
+    if (my @files = map { deslash $_ } glob "$user_dir/*-*/*") {
+
+        foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) {
+
+            my %file;
+
+            my ($file, $dir) = fileparse($_);
+            $dir = substr $dir, length $VAR;    # make it relative to $VAR
+
+            # FIXME: use the rx* patterns from above
+            $dir =~ m{/(?<expires>[a-z\d]{6})-(?<hash>[a-z\d]+)-(?<delete>.)}i
+              or next;
+            my ($hash, $expires, $delete) = @{+}{qw/hash expires delete/};
+            if (${expires} <= time and $delete eq 'e') {
+                /(.*)/;
+                unlink $_  or die "Can't unlik $_: $!\n";
+                rmdir $dir or die "Can't rmdir $dir: $!\n";
+                next;
+            }
+
+            my $d;
+            if ($delete eq 'e') {
+                $d = localtime ${expires};
+            }
+            elsif ($delete eq 'd') {
+                $d = 'unmittelbar nach Download';
+            }
+            else {
+                $d = 'nur manuell';
+            }
+
+            $file{name}          = $file;
+            $file{link}          = deslash "$ENV{PATH_INFO}/$dir$file";
+            $file{size}          = humanize -s $_;
+            $file{uploaded}      = (stat _)[9];
+            $file{removal}{type} = $d;
+            $file{removal}{link} = "?delete=$dir";
+
+            push @{ $tt{files} }, \%file;
+        }
+
+    }
+    $tt->process('inventory.html', \%tt) or 
+	die sprintf "template: %s\nINCLUDE_PATH:\n%s\n", $tt->error(),
+		join "\n", map { "'$_'" } @{$TT_CONFIG{INCLUDE_PATH}};
+    return 0;
+}
+
+sub deletedir {
+    remove_tree
+      map  { /^(\/.*)/ }
+      grep { /^\Q$VAR\E/ } @_;
+}
+
+sub humanize {
+    my $_     = shift;
+    my @units = qw(B K M G T);
+    while (length int > 3 and @units) {
+        $_ = sprintf "%.1f" => $_ / 1024;
+        shift @units;
+    }
+    croak "filesize is too big (can't convert to human readable number)"
+      if !@units;
+    return "$_$units[0]";
+}
+
+sub deslash { $_[0] =~ s{/+}{/}gr }
+
+sub confirm {
+    my ($base, $mimetype) = @_;
+    my %tt = (
+        file => {
+            name     => $base,
+            mimetype => $mimetype
+        }
+    );
+    my $tt = Template->new(\%TT_CONFIG)
+      or die $Template::ERROR;
+    $tt->process('confirm.html' => \%tt);
+    exit 0;
+}
+
+sub unbase62 {
+    my @digits = reverse split '', shift;
+    state $value = do {
+        my %value;
+        for (
+            my ($symbol, $value) = (base62(0), 0) ;
+            length($symbol) == 1 ;
+            $symbol = base62 ++$value
+          )
+        {
+            $value{$symbol} = $value;
+        }
+        \%value;
+    };
+    state $base = scalar keys %$value;
+
+    my $unbase62 = 0;
+    while (my ($p, $symbol) = each @digits) {
+        $unbase62 += $value->{$symbol} * $base**$p;
+    }
+    return $unbase62;
+}
+
+sub base62 {
+    my $n = shift // $_;
+    die 'input is >MAXINT' if $n == $n - 1 or $n == $n + 1;
+    state $digits = [0 .. 9, 'a' .. 'z', 'A' .. 'Z'];
+    state $base = @$digits;
+    my @result;
+
+    for (; $n >= $base ; $n = int($n / $base)) {
+        my $mod = $n % $base;
+        unshift @result, $digits->[$mod];
+    }
+    unshift @result, $digits->[$n];
+    join '', @result;
+}
+
+sub untaint {
+    my ($_, $rx) = (@_, qr((\w+)));
+    /$rx/;
+    die sprintf("%s:%s:%d: untaint('%s', %s): not defined\n", caller, $_, $rx)
+      if not defined $1;
+    return $1;
+}
+
+sub gen_uuid {
+
+    #open my $f, '/dev/urandom' or croak;
+    #read $f, my($_), 128/8;
+    #/^(.*)$/;
+    #die join '-', map { base62 $_ } unpack 'Q*', $1;
+    return base62 int rand(2**64);
+}
+
+# Download?
+# PATH_INFO is something like
+# /once/hDOPzMJMY0p/3fLjYmbYlGk-1450284310-d/boot.dot
+#       |-VIEW-----|                         |-BASE-|
+#       |-STORE----------------------------|
+# …     |-PATH--------------------------------------|
+sub handle_download {
+    my $path_info = shift;
+
+    $path_info =~ m{/(?<path>(?<store>(?<view>$rxVIEW)/$rxFILE)/(?<base>.*))}
+      or return 0;
+
+    #        use Data::Dumper;
+    #        die Dumper \%+;
+    my $view  = deslash realpath catfile $VAR, $+{view};
+    my $store = deslash realpath catfile $VAR, $+{store};
+    my $file  = deslash realpath catfile $VAR, $+{path};
+    my $base  = $+{base};
+
+    if (not -f $file) {
+	    my $tt = Template->new(\%TT_CONFIG)
+		      or die $Template::ERROR;
+            my %tt = ( file => { name => $base });
+	    
+	$tt->process('not-found.html', \%tt) or die $tt->error();
+        exit 0;
+    }
+
+    my $mimetype = mimetype($file);
+    confirm $base, $mimetype
+      if $store =~ /-d$/ and not defined param('confirmed');
+
+    open my $f, '<', $file or die "Can't open <`$file`: $!\n";
+    remove_tree $1 if $store =~ m(^(/.*-d)$);
+    rmdir $1 if $view =~ m(^(/.*));
+
+    print header(-type => $mimetype, -charset => 'UTF-8');
+    if (request_method() ~~ [qw(GET POST)]) {
+        local $/ = \do { 1 * 2**20 };    # 1 MB Buffer
+        print while <$f>;
+    }
+
+    return 1;
+}
+
+sub handle_removal {
+    my $delete = shift;
+
+
+    return 0
+        if not $delete =~ m{(?<store>(?<view>$rxVIEW)/$rxFILE/?)};
+
+    # FIXME: sanitization
+    my $store = untaint(deslash(catfile $VAR, $+{store}), qr{(\Q$VAR\E.+)});
+    my $view  = untaint(deslash(catfile $VAR, $+{view}), qr{(\Q$VAR\E.+)});
+
+    die "<< $store | $view ($+{store} $+{view}) >>";
+
+    remove_tree $store;
+    rmdir $view;
+    print redirect(-uri => url(-path_info => 1));
+
+    return 1;
+}
+
diff -r a4a87929803f -r b0f2dfaa34ac configs/apache.conf
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/configs/apache.conf	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,45 @@
+# This file should be placed as
+# -> /etc/apache2/conf-available/once.conf
+# and then you may use `a2enconf once`
+
+<Macro ONCE $location $var $lib>
+    SetEnv ONCE_VAR $var
+    SetEnv ONCE_LIB $lib
+
+    # The directory where the files are stored.
+    # This directory needs to be r/w by the web server user 
+    # (wwwrun, www-data, who ever), but it must not be
+    # accessible via HTTP(s)
+    <Directory "$var">
+	Require all denied
+    </Directory>
+
+    Action	once-handler	    /once-handler/once.cgi virtual
+    ScriptAlias /once-handler/	    $lib/
+    Alias	$location/static    $lib/static
+
+    # Order of location blocks matters!
+    # We handle requests to our script, with the exception (see below)
+    # for …/static/… requests. These should be answered from a simple
+    # static directory for style sheets and similiar
+    <Location "$location">
+	    SetHandler once-handler
+    </Location>
+    <Location "$location/static">
+	    SetHandler none
+    </Location>
+
+    <Directory "$lib/static">
+	Require all granted
+	Allow from all
+    </Directory>
+
+    <Directory "$lib">
+	Require all granted
+	Allow from all
+	Options ExecCGI FollowSymlinks
+    </Directory>
+</Macro>
+
+Use ONCE /once /var/lib/once /usr/local/lib/once
+UndefMacro ONCE
diff -r a4a87929803f -r b0f2dfaa34ac d/dot.htaccess
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/d/dot.htaccess	Mon Jan 04 15:02:00 2016 +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 a4a87929803f -r b0f2dfaa34ac debdeps.control
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/debdeps.control	Mon Jan 04 15:02:00 2016 +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 a4a87929803f -r b0f2dfaa34ac dot.htaccess
--- a/dot.htaccess	Fri May 13 17:01:33 2011 +0200
+++ b/dot.htaccess	Mon Jan 04 15:02:00 2016 +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 "once.pl">
+    AuthType Basic
+    AuthName upload
+    Require valid-user
+    AuthUserFile <FOO>/htpasswd
+    Order allow,deny
+</Files>
+<Files "once.pl">
+    Order allow,deny
+</Files>
diff -r a4a87929803f -r b0f2dfaa34ac lib/Once.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Once.pm	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,13 @@
+package Once;
+
+use strict;
+use warnings;
+use base 'Exporter';
+
+our $VERSION = 0.0;
+our @EXPORT_OK = qw(realpath);
+
+sub realpath {
+}
+
+1;
diff -r a4a87929803f -r b0f2dfaa34ac lib/version.PL
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/version.PL	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,16 @@
+#! /usr/bin/perl
+my $outfile = shift;
+
+my $now = localtime;
+chomp(my $version = `hg log -r . --template '{latesttag}-{latesttagdistance}-{node|short}\n'`);
+
+if (defined $outfile) {
+	open(STDOUT, '>',  $_ = $outfile) or die "Can't open $_: $!\n";
+}
+
+print <<_;
+[%# autogenerated at $now by $0 %]
+[% vcs.version = "$version"; %]
+_
+
+utime 0, 0 => $outfile
diff -r a4a87929803f -r b0f2dfaa34ac t/00-basic.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/00-basic.t	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,7 @@
+use Test::More qw(no_plan);
+
+BEGIN {
+    use_ok 'Once', qw(realpath);
+}
+
+is realpath('/'), '/' => 'realpath /';
diff -r a4a87929803f -r b0f2dfaa34ac templates/README
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/README	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,5 @@
+Do not overwrite the files here. If you want to modify something,
+put your versions to "templates" in your lib directory.
+
+	/usr/local/lib/once/templates/		for your modifications
+	/usr/local/lib/once/templates.default   for default templates
diff -r a4a87929803f -r b0f2dfaa34ac templates/confirm.html
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/confirm.html	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,11 @@
+[% WRAPPER once.tt %]
+<h1>Download bestätigen</h1>
+<hr />
+Die Datei <em>[% file.name %]</em> ([% file.mimetype %]) 
+wird nach Abschluß des Downloads gelöscht werden
+
+<form method='post'>
+    <input type='hidden' name='confirmed' value='yes' />
+    <input type='submit' name='.submit' value='Download' />
+</form>
+[% END %]
diff -r a4a87929803f -r b0f2dfaa34ac templates/inventory.html
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/inventory.html	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,48 @@
+[% WRAPPER once.tt %]
+<h1>Ansicht: [% view %]</h1>
+
+[%# The following part is the "inventory", that is, if there are any files %]
+[% IF files %]
+    <p>
+    Der gültige Download-Link ist die Link-Adresse, die sich hinter
+    dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste,
+    Link-Location).  Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a>
+    wird die Datei automatisch gelöscht.
+    </p>
+
+    <hr />
+
+    [%# Table for the files, our repository %]
+
+    <table>
+    <tr><th>Name</th><th>Größe</th><th>Hochgeladen</th><th>Löschung</hr><th>Aktion</th>
+    </tr>
+    [% FOREACH file IN files %]
+	<tr>
+	<td><a href="[% file.link %]">[% file.name %]</a></td>
+	<td align="right">[% file.size %]</td>
+	<td>[% date.format(file.uploaded, "%c") %]</td>
+	<td>[% file.removal.type %]</td>
+	<td><a href="[% file.removal.link %]">remove</a></td>
+	</td>
+    [% END # foreach %]
+    </table>
+    <hr />
+[% END # files %]
+
+[%# Form for upload %]
+<!-- Using a table is stupid, should use more modern HTML -->
+<form method="post" enctype="multipart/form-data">
+<table>
+<tr><td>Dateiname: </td>
+    <td><input type="file" name="upload" value="nothing" /></td>
+</tr><tr>
+    <td>Löschen in: </td><td><input type="text" name="expires" value="0" /></td>
+    <td>Tagen (0: unmittelbar nach Download, -1: manuell)</td>
+</tr><tr>
+    <td /><td><input type="submit" name=".submit" value="Hochladen" /></td>
+</tr>
+</table>
+</form>
+
+[% END %]
diff -r a4a87929803f -r b0f2dfaa34ac templates/not-found.html
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/not-found.html	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,4 @@
+[% WRAPPER once.tt %]
+<h1>Sorry</h1>
+Das File <em>[% file.name %]</em> existiert (nicht) mehr.
+[% END %]
diff -r a4a87929803f -r b0f2dfaa34ac templates/once.tt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/once.tt	Mon Jan 04 15:02:00 2016 +0100
@@ -0,0 +1,25 @@
+Content-Type: text/html; charset=utf-8
+
+<html>
+[%-
+    USE date;
+-%]
+<head>
+<title>Once</title>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<style type="text/css">
+    th { text-align: left; }
+</style>
+<link rel="stylesheet" href="once/static/once.css">
+</head>
+<body>
+
+[% content %]
+
+<hr />
+<div align="right">
+    <font size=1>[% vcs.version %] | Scripting: Matthias Förste, Heiko Schlittermann</font>
+</div>
+</body>
+</html>
+[%# vim:ft=html: %]
diff -r a4a87929803f -r b0f2dfaa34ac upload.pl
--- a/upload.pl	Fri May 13 17:01:33 2011 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,182 +0,0 @@
-#! /usr/bin/perl -T
-# Example .htaccess
-# | Options -Indexes
-# | <Files upload.pl>
-# | AuthType Basic
-# | AuthName upload
-# | Require valid-user
-# | AuthUserFile /home/heiko/public_html/.passwd
-# | </Files>
-#
-# Je nach Permission-Lage kann es gut sein, daß das upload.d-Verzeichnis
-# mit der Hand angelegt werden muß und dem Webserver-Nutzer „geschenkt“
-# werden muß.
-#
-# Das Upload-Verzeichnis sollte natuerlich vor der Indizierung geschuetzt
-# werden - siehe Beispiel .htaccess.
-#
-# Eventuell in der Apache-Config sowas wie
-#   ScriptAlias /ud	    /home/ud/XXX/upload.pl
-#   Alias	/d	    /home/ud/XXX/d/
-# gesetzt werden.
-
-use 5.010;
-use strict;
-use warnings;
-use CGI qw(:all *table);
-use CGI::Carp qw(fatalsToBrowser);
-use CGI::Pretty;
-use File::Basename;
-use Digest::MD5 qw(md5_hex);
-use OSSP::uuid;
-
-my $DIR     = "d/{view}";
-my $DIR_URI = "/$DIR";
-
-sub human($);
-
-delete @ENV{ grep /PATH/, keys %ENV };
-$ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin";
-
-$_ = dirname $DIR;
--d or mkdir $_ => 0750
-  or die "Can't mkdir $_: $!\n";
-
-MAIN: {
-
-    # per view we have an own directory
-
-    $ENV{REMOTE_USER} =~ /(.*)/;
-    $_ = md5_hex($1);
-    $DIR     =~ s/{view}/$_/g;
-    $DIR_URI =~ s/{view}/$_/g;
-    -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";
-        }
-        print redirect(-uri => url(-path_info => 1));
-        exit 0;
-    }
-
-    print header(-charset => "UTF-8"),
-      start_html(-title => "Up&Down"),
-      h1 "Ansicht: $ENV{REMOTE_USER}";
-
-    # print Dump;
-
-    if (length(my $file = param("upload"))) {
-        my $days = param("expires");
-        my $expires;
-        tie my $uuid => "OSSP::uuid::tie", "v4";
-
-        # sanitize expires
-        $days =~ /.*?(\d+).*/;
-        $days = defined $1 ? $1 : 10;
-        $expires = time + $days * 86400;
-
-        # sanitizing the filename
-        (my $filename = $file) =~ tr /\\/\//;
-        $filename =~ /(.*)/;
-        $filename = $1;
-
-        my $dir = "$DIR/$uuid-$expires";
-        mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n";
-        open(my $outfh, ">" => "$dir/$filename")
-          or die "Can't create $dir/$filename: $!\n";
-        print {$outfh} <$file>;
-
-        if (open(my $atfh, "|-" => "at now + $days days")) {
-            print {$atfh}
-              "rm -f \"$dir/$filename\"\n",
-              "rmdir \"$dir\"\n";
-            close $atfh;
-            system("cat /tmp/log");
-        }
-
-    }
-    print hr;
-
-    if (my @files = glob "$DIR/*-*/*") {
-
-        #print "<pre>",
-        #(map { "$_: $ENV{$_}\n" } sort keys %ENV),
-        #"</pre>";
-
-        print p <<__;
-			Der gültige Download-Link ist die Link-Adresse, die sich hinter
-			dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location).
-			Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a>
-			wird die Datei automatisch gelöscht.
-__
-
-        print start_table,
-          Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]);
-
-        foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {
-            my ($file, $dir) = fileparse($_);
-            $dir = basename $dir;
-
-            # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
-            $dir =~ /(\S+)-(\d+)$/ or next;
-            my $hash    = $1;
-            my $expires = $2;
-            if (${expires} <= time) {
-                /(.*)/;
-                unlink $_  or die "Can't unlik $_: $!\n";
-                rmdir $dir or die "Can't rmdir $dir: $!\n";
-                next;
-            }
-
-            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(a({ href => "?delete=$dir" }, "remove"))
-            );
-        }
-
-        print end_table, hr;
-    }
-
-    print start_multipart_form, start_table,
-      Tr(td("Dateiname: "),
-        td(filefield(-name => "upload", -default => "nothing")),
-      ),
-      Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)),
-        td("Tagen")),
-      Tr(td(), td(submit(-value => "Hochladen")),),
-      end_table,
-      end_multipart_form;
-
-    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 human($) {
-    my $_     = shift;
-    my @units = qw(B K M G T);
-    while (length int > 3 and @units) {
-        $_ = sprintf "%.1f" => $_ / 1024;
-        shift @units;
-    }
-    croak "filesize is too big (can't convert to human readable number"
-      if !@units;
-    return "$_$units[0]";
-}