46 -d or mkdir $_ => 0750 |
46 -d or mkdir $_ => 0750 |
47 or die "Can't mkdir $_: $!\n"; |
47 or die "Can't mkdir $_: $!\n"; |
48 |
48 |
49 MAIN: { |
49 MAIN: { |
50 |
50 |
51 # assuming download request |
51 # assuming download request |
52 if (request_uri =~ m|^\Q$DIR_URI\E/(.+)$|) { |
52 if (request_uri =~ m|^\Q$DIR_URI\E/(.+)$|) { |
53 # assuming $DIR relative to cwd |
53 |
54 my $relative = $1; |
54 # assuming $DIR relative to cwd |
55 my $base = getcwd; |
55 my $relative = $1; |
56 my $absolute; |
56 my $base = getcwd; |
57 unless ($absolute = realpath "$base/$DIR/$relative") { |
57 my $absolute; |
58 die "Can't realpath '$base/$DIR/$relative': $!" unless exists $!{ENOENT} and $!{ENOENT}; |
58 unless ($absolute = realpath "$base/$DIR/$relative") { |
59 print header('text/plain', '404 Not found'); |
59 die "Can't realpath '$base/$DIR/$relative': $!" |
60 print "Not found"; |
60 unless exists $!{ENOENT} and $!{ENOENT}; |
61 exit 0; |
61 print header('text/plain', '404 Not found'); |
62 } |
62 print "Not found"; |
63 $absolute =~ m|^\Q$base/$DIR\E| or die "invalid path: [$absolute]"; |
63 exit 0; |
64 |
64 } |
65 open F, '<', $absolute or die "Can't open '<', '$absolute': $!"; |
65 $absolute =~ m|^\Q$base/$DIR\E| or die "invalid path: [$absolute]"; |
66 print header(-type => mimetype($absolute)); |
66 |
67 if (request_method() ~~ [qw(GET POST)]) { |
67 open F, '<', $absolute or die "Can't open '<', '$absolute': $!"; |
68 my ($buf, $res); |
68 print header(-type => mimetype($absolute)); |
69 print $buf while $res = read F, $buf, 32*2**10; |
69 if (request_method() ~~ [qw(GET POST)]) { |
70 defined $res or die "Can't read: $!"; |
70 my ($buf, $res); |
71 |
71 print $buf while $res = read F, $buf, 32 * 2**10; |
72 (my $dir = $relative) =~ s|/[^/]+$||; |
72 defined $res or die "Can't read: $!"; |
73 deletedir $dir if $dir =~ /-d$/; |
73 |
74 } |
74 (my $dir = $relative) =~ s|/[^/]+$||; |
75 exit 0; |
75 deletedir $dir if $dir =~ /-d$/; |
76 |
76 } |
77 } |
77 exit 0; |
|
78 |
|
79 } |
78 |
80 |
79 # per view we have an own directory |
81 # per view we have an own directory |
80 |
82 |
81 $ENV{REMOTE_USER} =~ /(.*)/; |
83 $ENV{REMOTE_USER} =~ /(.*)/; |
82 $_ = md5_hex($1); |
84 $_ = md5_hex($1); |
83 $DIR .= "/$_"; |
85 $DIR .= "/$_"; |
84 $DIR_URI .= "/$_"; |
86 $DIR_URI .= "/$_"; |
85 -d $DIR |
87 -d $DIR |
86 or mkdir $DIR => 0750 |
88 or mkdir $DIR => 0750 |
87 or die "Can't mkdir $DIR: $!\n"; |
89 or die "Can't mkdir $DIR: $!\n"; |
88 |
90 |
89 if (param("delete") =~ /([-a-z\d]+-\d+-.)/i) { |
91 if (param("delete") =~ /([-a-z\d]+-\d+-.)/i) { |
106 # sanitize expires |
108 # sanitize expires |
107 $days =~ /.*?([+-]?\d+).*/; |
109 $days =~ /.*?([+-]?\d+).*/; |
108 $days = defined $1 ? $1 : 10; |
110 $days = defined $1 ? $1 : 10; |
109 |
111 |
110 $expires = time + $days * 86400; |
112 $expires = time + $days * 86400; |
111 $delete = 'l'; # on file[l]ist |
113 $delete = 'l'; # on file[l]ist |
112 if ($days == 0) { |
114 if ($days == 0) { |
113 $delete = 'd'; # on first [d]ownload |
115 $delete = 'd'; # on first [d]ownload |
114 } elsif ($days == -1) { |
116 } elsif ($days == -1) { |
115 $delete = 'm'; # only [m]anually |
117 $delete = 'm'; # only [m]anually |
116 } |
118 } |
117 |
119 |
118 # sanitizing the filename |
120 # sanitizing the filename |
119 (my $filename = $file) =~ tr /\\/\//; |
121 (my $filename = $file) =~ tr /\\/\//; |
120 $filename =~ /(.*)/; |
122 $filename =~ /(.*)/; |
121 $filename = $1; |
123 $filename = $1; |
124 mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; |
126 mkdir $dir, 0750 or die "Can't mkdir $dir: $!\n"; |
125 my $outfh = new IO::File ">$dir/$filename" |
127 my $outfh = new IO::File ">$dir/$filename" |
126 or die "Can't create $dir/$filename: $!\n"; |
128 or die "Can't create $dir/$filename: $!\n"; |
127 print {$outfh} <$file>; |
129 print {$outfh} <$file>; |
128 |
130 |
129 if (not $delete ~~ [qw(d m)] and my $atfh = new IO::File("|at now + $days days")) { |
131 if (not $delete ~~ [qw(d m)] |
|
132 and my $atfh = new IO::File("|at now + $days days")) |
|
133 { |
130 print {$atfh} |
134 print {$atfh} |
131 "rm -f \"$dir/$filename\"\n", |
135 "rm -f \"$dir/$filename\"\n", |
132 "rmdir \"$dir\"\n"; |
136 "rmdir \"$dir\"\n"; |
133 close $atfh; |
137 close $atfh; |
134 system("cat /tmp/log"); |
138 system("cat /tmp/log"); |
190 |
194 |
191 print start_multipart_form, start_table, |
195 print start_multipart_form, start_table, |
192 Tr(td("Dateiname: "), |
196 Tr(td("Dateiname: "), |
193 td(filefield(-name => "upload", -default => "nothing")), |
197 td(filefield(-name => "upload", -default => "nothing")), |
194 ), |
198 ), |
195 Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 0)), |
199 Tr( |
196 td("Tagen (0: unmittelbar nach Download; -1: nur manuell)")), |
200 td("Löschen in: "), |
|
201 td(textfield(-name => "expires", -default => 0)), |
|
202 td("Tagen (0: unmittelbar nach Download; -1: nur manuell)") |
|
203 ), |
197 Tr(td(), td(submit(-value => "Hochladen")),), |
204 Tr(td(), td(submit(-value => "Hochladen")),), |
198 end_table, |
205 end_table, |
199 end_multipart_form; |
206 end_multipart_form; |
200 |
207 |
201 print hr, |
208 print hr, |