# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1253223183 -7200
# Node ID 6d8dea55365acbe7c0c2d1c77771cceedf15c27a

initial version

diff -r 000000000000 -r 6d8dea55365a upload.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/upload.pl	Thu Sep 17 23:33:03 2009 +0200
@@ -0,0 +1,96 @@
+#! /usr/bin/perl -T
+# Example .htaccess
+# | <Files upload.pl>
+# | AuthType Basic
+# | AuthName upload
+# | Require valid-user
+# | AuthUserFile /home/heiko/public_html/.passwd
+# | </Files>
+
+use strict;
+use warnings;
+use CGI qw(:all *table);
+use CGI::Carp qw(fatalsToBrowser);
+use CGI::Pretty;
+use IO::File;
+use File::Basename;
+use Digest::SHA1 qw(sha1_hex);
+
+my $DIR = "upload.d";
+my $LINK_DIR = url(-base => 1) . dirname($ENV{SCRIPT_NAME}) . "/$DIR";
+
+-d $DIR
+  or mkdir $DIR => 0750
+  or die "Can't mkdir $DIR: $!\n";
+
+MAIN: {
+    print header(-charset => "UTF-8"), start_html,
+      h1 "View: $ENV{REMOTE_USER}";
+
+    # print Dump;
+
+    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 (length(my $file = param("upload"))) {
+        my $expires = param("expires");
+
+        # sanitize expires
+        $expires =~ /.*?(\d+).*/;
+        $expires = time + (defined $1 ? $1 : 10) * 86400;
+
+        # sanitizing the filename
+        (my $filename = $file) =~ tr /\\/\//;
+        $filename =~ /(.*)/;
+        $filename = $1;
+
+        my $dir = "$DIR/" . sha1_hex(time + rand(10_000)) . "-$expires";
+        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>;
+    }
+    print hr;
+
+    print start_table, Tr(th { align => "left" }, [qw/name size date expires/]);
+
+    foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {
+        my ($file, $dir) = fileparse($_);
+        $dir = basename $dir;
+        $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
+        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 => "$LINK_DIR/$dir/$file" }, $file),
+            td({ align => "right" }, (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 end_html;
+}