--- a/upload.pl Wed May 11 12:22:00 2011 +0200
+++ b/upload.pl Wed May 11 12:24:35 2011 +0200
@@ -11,7 +11,7 @@
# 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.
#
@@ -31,17 +31,17 @@
use Digest::MD5 qw(md5_hex);
use OSSP::uuid;
-my $DIR = "d/{view}";
+my $DIR = "d/{view}";
my $DIR_URI = "/$DIR";
sub human($);
-delete @ENV{grep /PATH/, keys %ENV};
+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";
+ or die "Can't mkdir $_: $!\n";
MAIN: {
@@ -49,12 +49,11 @@
$ENV{REMOTE_USER} =~ /(.*)/;
$_ = md5_hex($1);
- $DIR =~ s/{view}/$_/g;
+ $DIR =~ s/{view}/$_/g;
$DIR_URI =~ s/{view}/$_/g;
-d $DIR
- or mkdir $DIR => 0750
- or die "Can't mkdir $DIR: $!\n";
-
+ or mkdir $DIR => 0750
+ or die "Can't mkdir $DIR: $!\n";
if (param("delete") =~ /([-a-z\d]+-\d+)/i) {
my $dir = $1;
@@ -63,28 +62,25 @@
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 redirect(-uri => url(-path_info => 1));
+ exit 0;
}
- print header(-charset => "UTF-8"),
- start_html(-title => "Up&Down"),
- h1 "Ansicht: $ENV{REMOTE_USER}";
-
+ 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 $days = param("expires");
my $expires;
- tie my $uuid => "OSSP::uuid::tie", "v4";
+ tie my $uuid => "OSSP::uuid::tie", "v4";
# sanitize expires
$days =~ /.*?(\d+).*/;
- $days = defined $1 ? $1 : 10;
+ $days = defined $1 ? $1 : 10;
$expires = time + $days * 86400;
-
# sanitizing the filename
(my $filename = $file) =~ tr /\\/\//;
@@ -97,58 +93,59 @@
or die "Can't create $dir/$filename: $!\n";
print {$outfh} <$file>;
- if (my $atfh = new IO::File("|at now + $days days")) {
- print {$atfh}
- "rm -f \"$dir/$filename\"\n",
- "rmdir \"$dir\"\n";
- close $atfh;
- system("cat /tmp/log");
- }
+ if (my $atfh = new IO::File("|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/*-*/*") {
+ if (my @files = glob "$DIR/*-*/*") {
- #print "<pre>",
- #(map { "$_: $ENV{$_}\n" } sort keys %ENV),
- #"</pre>";
+ #print "<pre>",
+ #(map { "$_: $ENV{$_}\n" } sort keys %ENV),
+ #"</pre>";
- print p <<__;
+ 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/]);
+ 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;
+ 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;
- }
+ # $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 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 end_table, hr;
+ }
print start_multipart_form, start_table,
Tr(td("Dateiname: "),
@@ -161,21 +158,26 @@
end_multipart_form;
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;
+ 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 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]";
+ 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]";
}