39 use File::MimeInfo qw(mimetype); |
40 use File::MimeInfo qw(mimetype); |
40 use Cwd qw(getcwd realpath); |
41 use Cwd qw(getcwd realpath); |
41 use Digest::MD5 qw(md5_hex); |
42 use Digest::MD5 qw(md5_hex); |
42 use OSSP::uuid; |
43 use OSSP::uuid; |
43 |
44 |
44 |
45 sub human; # convert numbers to human readable format |
45 sub human; # convert numbers to human readable format |
46 sub deletedir; # safely delete directories |
46 sub deletedir; # safely delete directories |
47 sub confirm; # ask for user confirmation (HTML) |
47 sub confirm; # ask for user confirmation (HTML) |
48 sub deslash; # cleanup a path name |
48 sub deslash; # cleanup a path name |
|
49 |
49 |
50 my $uuid = qr/[[:xdigit:]-]{36}/; |
50 my $uuid = qr/[[:xdigit:]-]{36}/; |
51 my $hash = qr/[[:xdigit:]]{32}/; |
51 my $hash = qr/[[:xdigit:]]{32}/; |
52 |
52 |
53 umask 077; |
53 umask 077; |
80 ); |
79 ); |
81 |
80 |
82 MAIN: { |
81 MAIN: { |
83 |
82 |
84 # Download? |
83 # Download? |
85 if ($ENV{PATH_INFO} =~ m{(?<path>(?<store>(?<view>/$hash|$uuid)/$uuid-\d+-.)/(?<base>.*))}) { |
84 if ($ENV{PATH_INFO} =~ |
86 my $view = deslash realpath catfile $ONCE_VAR, $+{view}; |
85 m{(?<path>(?<store>(?<view>/$hash|$uuid)/$uuid-\d+-.)/(?<base>.*))}) |
|
86 { |
|
87 my $view = deslash realpath catfile $ONCE_VAR, $+{view}; |
87 my $store = deslash realpath catfile $ONCE_VAR, $+{store}; |
88 my $store = deslash realpath catfile $ONCE_VAR, $+{store}; |
88 my $file = deslash realpath catfile $ONCE_VAR, $+{path}; |
89 my $file = deslash realpath catfile $ONCE_VAR, $+{path}; |
89 my $base = $+{base}; |
90 my $base = $+{base}; |
90 |
91 |
91 unless (-f $file) { |
92 unless (-f $file) { |
92 print header('text/plain', '404 Not found'), 'Not found'; |
93 print header('text/plain', '404 Not found'), 'Not found'; |
93 exit 0; |
94 exit 0; |
94 } |
95 } |
95 |
96 |
96 my $mimetype = mimetype($file); |
97 my $mimetype = mimetype($file); |
97 confirm $base, $mimetype if $store =~ /-d$/ and not defined param('confirmed'); |
98 confirm $base, $mimetype |
|
99 if $store =~ /-d$/ and not defined param('confirmed'); |
98 |
100 |
99 open my $f, '<', $file or die "Can't open <`$file`: $!\n"; |
101 open my $f, '<', $file or die "Can't open <`$file`: $!\n"; |
100 remove_tree $1 if $store =~ m(^(/.*-d)$); |
102 remove_tree $1 if $store =~ m(^(/.*-d)$); |
101 rmdir $1 if $view =~ m(^(/.*)); |
103 rmdir $1 if $view =~ m(^(/.*)); |
102 |
104 |
103 print header(-type => $mimetype, -charset => 'UTF-8'); |
105 print header(-type => $mimetype, -charset => 'UTF-8'); |
104 if (request_method() ~~ [qw(GET POST)]) { |
106 if (request_method() ~~ [qw(GET POST)]) { |
105 local $/ = \do{1 * 2**20}; # 1 MB Buffer |
107 local $/ = \do { 1 * 2**20 }; # 1 MB Buffer |
106 print while <$f>; |
108 print while <$f>; |
107 } |
109 } |
108 exit 0; |
110 exit 0; |
109 |
111 |
110 } |
112 } |
111 |
113 |
112 # UPLOAD / VIEW request |
114 # UPLOAD / VIEW request |
113 # per view (user) we have an own directory |
115 # per view (user) we have an own directory |
114 |
116 |
115 # pre condition checks |
117 # pre condition checks |
116 -d $ONCE_VAR or mkdir $ONCE_VAR => 0777 |
118 -d $ONCE_VAR |
117 or die "Can't mkdir $ONCE_VAR: $! (your admin should have created it)\n"; |
119 or mkdir $ONCE_VAR => 0777 |
118 |
120 or die "Can't mkdir $ONCE_VAR: $! (your admin should have created it)\n"; |
119 -x -w $ONCE_VAR or |
121 |
120 die "Can't write to $ONCE_VAR: $!\n"; |
122 -x -w $ONCE_VAR |
|
123 or die "Can't write to $ONCE_VAR: $!\n"; |
121 |
124 |
122 my ($view, $user_dir) = do { |
125 my ($view, $user_dir) = do { |
123 my ($v, $d); |
126 my ($v, $d); |
124 if ($ENV{REMOTE_USER} =~ /^\s*(.+)\s*$/) { |
127 if ($ENV{REMOTE_USER} =~ /^\s*(.+)\s*$/) { |
125 $v = $1; |
128 $v = $1; |
131 } |
134 } |
132 $v, deslash catfile($ONCE_VAR, $d); |
135 $v, deslash catfile($ONCE_VAR, $d); |
133 }; |
136 }; |
134 |
137 |
135 if (param('delete') =~ m{(?<store>(?<view>$uuid|$hash)/$uuid-\d+-./?)}) { |
138 if (param('delete') =~ m{(?<store>(?<view>$uuid|$hash)/$uuid-\d+-./?)}) { |
|
139 |
136 # FIXME: sanitization |
140 # FIXME: sanitization |
137 my $store = deslash catfile $ONCE_VAR, $+{store}; |
141 my $store = deslash catfile $ONCE_VAR, $+{store}; |
138 my $view = deslash catfile $ONCE_VAR, $+{view}; |
142 my $view = deslash catfile $ONCE_VAR, $+{view}; |
139 remove_tree $1 if $store =~ m(^(/.*)); |
143 remove_tree $1 if $store =~ m(^(/.*)); |
140 rmdir $1 if $view =~ m(^(/.*)); |
144 rmdir $1 if $view =~ m(^(/.*)); |
141 print redirect(-uri => url(-path_info => 1)); |
145 print redirect(-uri => url(-path_info => 1)); |
142 exit 0; |
146 exit 0; |
143 } |
147 } |
204 print start_table, |
208 print start_table, |
205 Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]); |
209 Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]); |
206 |
210 |
207 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) { |
211 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) { |
208 my ($file, $dir) = fileparse($_); |
212 my ($file, $dir) = fileparse($_); |
209 $dir = substr $dir, length $ONCE_VAR; # make it relative to $ONCE_VAR |
213 $dir = substr $dir, |
|
214 length $ONCE_VAR; # make it relative to $ONCE_VAR |
210 |
215 |
211 $dir =~ /(\S+)-(\d+)-(.)\/?$/ or next; |
216 $dir =~ /(\S+)-(\d+)-(.)\/?$/ or next; |
212 my ($hash, $expires, $delete) = ($1, $2, $3); |
217 my ($hash, $expires, $delete) = ($1, $2, $3); |
213 if (${expires} <= time and $delete eq 'l') { |
218 if (${expires} <= time and $delete eq 'l') { |
214 /(.*)/; |
219 /(.*)/; |