36 my $DIR = "d"; |
36 my $DIR = "d"; |
37 my $DIR_URI = "/once/$DIR"; |
37 my $DIR_URI = "/once/$DIR"; |
38 |
38 |
39 sub human($); |
39 sub human($); |
40 sub deletedir(@); |
40 sub deletedir(@); |
|
41 sub confirm; |
41 |
42 |
42 delete @ENV{ grep /PATH/, keys %ENV }; |
43 delete @ENV{ grep /PATH/, keys %ENV }; |
43 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin"; |
44 $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin"; |
44 |
45 |
45 $_ = dirname $DIR; |
46 $_ = dirname $DIR; |
46 -d or mkdir $_ => 0750 |
47 -d or mkdir $_ => 0750 |
47 or die "Can't mkdir $_: $!\n"; |
48 or die "Can't mkdir $_: $!\n"; |
|
49 |
|
50 my @footer = (hr, |
|
51 div( |
|
52 { -align => "right" }, |
|
53 a( |
|
54 { -href => "https://ssl.schlittermann.de/hg/anon-upload/file/once/" } => |
|
55 "Scripting" |
|
56 ), |
|
57 " © 2010,2011 ", |
|
58 a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann"), |
|
59 " © 2014 ", |
|
60 a({ -href => "http://www.schlittermann.de/" } => "Matthias Förste") |
|
61 )); |
48 |
62 |
49 MAIN: { |
63 MAIN: { |
50 |
64 |
51 # assuming download request |
65 # assuming download request |
52 if (request_uri =~ m|^\Q$DIR_URI\E/(.+)$|) { |
66 if (request_uri =~ m|^\Q$DIR_URI\E/(.+)$|) { |
56 my $base = getcwd; |
70 my $base = getcwd; |
57 my $absolute; |
71 my $absolute; |
58 unless ($absolute = realpath "$base/$DIR/$relative") { |
72 unless ($absolute = realpath "$base/$DIR/$relative") { |
59 die "Can't realpath '$base/$DIR/$relative': $!" |
73 die "Can't realpath '$base/$DIR/$relative': $!" |
60 unless exists $!{ENOENT} and $!{ENOENT}; |
74 unless exists $!{ENOENT} and $!{ENOENT}; |
61 print header('text/plain', '404 Not found'); |
75 print header('text/plain', '404 Not found'), 'Not found'; |
62 print "Not found"; |
|
63 exit 0; |
76 exit 0; |
64 } |
77 } |
65 $absolute =~ m|^\Q$base/$DIR\E| or die "invalid path: [$absolute]"; |
78 $absolute =~ m|^\Q$base/$DIR\E| or die "invalid path: [$absolute]"; |
|
79 |
|
80 (my $dir = $relative) =~ s|/[^/]+$||; |
|
81 my $delete = $dir =~ /-d$/; |
|
82 |
|
83 confirm if ($delete and not defined param('confirmed')); |
66 |
84 |
67 open F, '<', $absolute or die "Can't open '<', '$absolute': $!"; |
85 open F, '<', $absolute or die "Can't open '<', '$absolute': $!"; |
68 print header(-type => mimetype($absolute), -charset => 'UTF-8'); |
86 print header(-type => mimetype($absolute), -charset => 'UTF-8'); |
69 if (request_method() ~~ [qw(GET POST)]) { |
87 if (request_method() ~~ [qw(GET POST)]) { |
70 my ($buf, $res); |
88 my ($buf, $res); |
71 print $buf while $res = read F, $buf, 32 * 2**10; |
89 print $buf while $res = read F, $buf, 32 * 2**10; |
72 defined $res or die "Can't read: $!"; |
90 defined $res or die "Can't read: $!"; |
73 |
91 |
74 (my $dir = $relative) =~ s|/[^/]+$||; |
92 deletedir $dir if $delete; |
75 deletedir $dir if $dir =~ /-d$/; |
|
76 } |
93 } |
77 exit 0; |
94 exit 0; |
78 |
95 |
79 } |
96 } |
80 |
97 |
201 td(textfield(-name => "expires", -default => 0)), |
218 td(textfield(-name => "expires", -default => 0)), |
202 td("Tagen (0: unmittelbar nach Download; -1: nur manuell)") |
219 td("Tagen (0: unmittelbar nach Download; -1: nur manuell)") |
203 ), |
220 ), |
204 Tr(td(), td(submit(-value => "Hochladen")),), |
221 Tr(td(), td(submit(-value => "Hochladen")),), |
205 end_table, |
222 end_table, |
206 end_multipart_form; |
223 end_multipart_form, |
207 |
224 @footer, |
208 print hr, |
|
209 div( |
|
210 { -align => "right" }, |
|
211 a( |
|
212 { -href => "https://ssl.schlittermann.de/hg/anon-upload/file/once/" } => |
|
213 "Scripting" |
|
214 ), |
|
215 " © 2010,2011 ", |
|
216 a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann"), |
|
217 " © 2014 ", |
|
218 a({ -href => "http://www.schlittermann.de/" } => "Matthias Förste") |
|
219 ), |
|
220 end_html; |
225 end_html; |
221 } |
226 } |
222 |
227 |
223 sub deletedir(@) { |
228 sub deletedir(@) { |
224 for my $dir (@_) { |
229 for my $dir (@_) { |
239 } |
244 } |
240 croak "filesize is too big (can't convert to human readable number" |
245 croak "filesize is too big (can't convert to human readable number" |
241 if !@units; |
246 if !@units; |
242 return "$_$units[0]"; |
247 return "$_$units[0]"; |
243 } |
248 } |
|
249 |
|
250 sub confirm { |
|
251 print header(-charset => "UTF-8"), |
|
252 start_html(-title => "once"), |
|
253 h1 "Download bestätigen"; |
|
254 print hr, |
|
255 p <<__; |
|
256 Die Datei die Sie herunterladen möchten wird nach Abschluß des |
|
257 Downloads gelöscht. Um zu verhindern, daß Virenscanner oder andere |
|
258 Programme die diesen Link automatisiert aufrufen die Löschung der Datei |
|
259 auslösen bestätigen Sie bitte den Download per Knopfdruck. |
|
260 __ |
|
261 print start_form, hidden('confirmed', 'yes'), submit(-value => 'Bestätigung'), end_form, @footer, end_html; |
|
262 exit 0; |
|
263 } |