63 # The working (var) directory gets passed to us via ONCE_VAR environment |
63 # The working (var) directory gets passed to us via ONCE_VAR environment |
64 # FIXME: Should we allow the current directory as an alternative? |
64 # FIXME: Should we allow the current directory as an alternative? |
65 |
65 |
66 die "Environment ONCE_VAR needs to be defined\n" |
66 die "Environment ONCE_VAR needs to be defined\n" |
67 if not defined $ENV{ONCE_VAR}; |
67 if not defined $ENV{ONCE_VAR}; |
68 my $ONCE_VAR = untaint($ENV{ONCE_VAR}, qr((^/.*))); |
68 my $VAR = untaint($ENV{ONCE_VAR}, qr((^/.*))); |
69 |
69 |
70 exit main() if not caller; |
70 exit main() if not caller; |
71 |
71 |
72 sub main { |
72 sub main { |
73 |
73 |
74 # Handle the UPLOAD / VIEW request |
74 # Handle the UPLOAD / VIEW request |
75 # per view (user) we have an own directory |
75 # per view (user) we have an own directory |
76 |
76 |
77 # pre condition checks |
77 # pre condition checks |
78 -d $ONCE_VAR |
78 -d $VAR |
79 or mkdir $ONCE_VAR => 0777 |
79 or mkdir $VAR => 0777 |
80 or die "Can't mkdir $ONCE_VAR: $! (your admin should have created it)\n"; |
80 or die "Can't mkdir $VAR: $! (your admin should have created it)\n"; |
81 |
81 |
82 -x -w $ONCE_VAR |
82 -x -w $VAR |
83 or die "Can't write to $ONCE_VAR: $!\n"; |
83 or die "Can't write to $VAR: $!\n"; |
84 |
84 |
85 # Download? |
85 # Download? |
86 # PATH_INFO is something like |
86 # PATH_INFO is something like |
87 # /once/hDOPzMJMY0p/3fLjYmbYlGk-1450284310-d/boot.dot |
87 # /once/hDOPzMJMY0p/3fLjYmbYlGk-1450284310-d/boot.dot |
88 # |-VIEW-----| |-BASE-| |
88 # |-VIEW-----| |-BASE-| |
91 if ($ENV{PATH_INFO} =~ |
91 if ($ENV{PATH_INFO} =~ |
92 m{/(?<path>(?<store>(?<view>$rxVIEW)/$rxFILE)/(?<base>.*))}) |
92 m{/(?<path>(?<store>(?<view>$rxVIEW)/$rxFILE)/(?<base>.*))}) |
93 { |
93 { |
94 # use Data::Dumper; |
94 # use Data::Dumper; |
95 # die Dumper \%+; |
95 # die Dumper \%+; |
96 my $view = deslash realpath catfile $ONCE_VAR, $+{view}; |
96 my $view = deslash realpath catfile $VAR, $+{view}; |
97 my $store = deslash realpath catfile $ONCE_VAR, $+{store}; |
97 my $store = deslash realpath catfile $VAR, $+{store}; |
98 my $file = deslash realpath catfile $ONCE_VAR, $+{path}; |
98 my $file = deslash realpath catfile $VAR, $+{path}; |
99 my $base = $+{base}; |
99 my $base = $+{base}; |
100 |
100 |
101 unless (-f $file) { |
101 unless (-f $file) { |
102 print header('text/plain', '404 Not found'), 'Not found'; |
102 print header('text/plain', '404 Not found'), 'Not found'; |
103 exit 0; |
103 exit 0; |
150 else { |
150 else { |
151 # Anonymous get an timestamp()-rand(1000) directory |
151 # Anonymous get an timestamp()-rand(1000) directory |
152 $d = join '-' => base62(time), base62(rand(10_000)); |
152 $d = join '-' => base62(time), base62(rand(10_000)); |
153 $v = 'anonymous'; |
153 $v = 'anonymous'; |
154 } |
154 } |
155 $v, deslash catfile($ONCE_VAR, $d); |
155 $v, deslash catfile($VAR, $d); |
156 }; |
156 }; |
157 |
157 |
158 # Handle the removal request and we're done |
158 # Handle the removal request and we're done |
159 if (param('delete') =~ m{(?<store>(?<view>$rxVIEW)/$rxFILE/?)}) { |
159 if (param('delete') =~ m{(?<store>(?<view>$rxVIEW)/$rxFILE/?)}) { |
160 |
160 |
161 # FIXME: sanitization |
161 # FIXME: sanitization |
162 my $store = deslash catfile $ONCE_VAR, $+{store}; |
162 my $store = deslash catfile $VAR, $+{store}; |
163 my $view = deslash catfile $ONCE_VAR, $+{view}; |
163 my $view = deslash catfile $VAR, $+{view}; |
164 remove_tree $1 if $store =~ m(^(/.*)); |
164 remove_tree $1 if $store =~ m(^(/.*)); |
165 rmdir $1 if $view =~ m(^(/.*)); |
165 rmdir $1 if $view =~ m(^(/.*)); |
166 print redirect(-uri => url(-path_info => 1)); |
166 print redirect(-uri => url(-path_info => 1)); |
167 exit 0; |
167 exit 0; |
168 } |
168 } |
225 |
225 |
226 my %file; |
226 my %file; |
227 |
227 |
228 my ($file, $dir) = fileparse($_); |
228 my ($file, $dir) = fileparse($_); |
229 $dir = substr $dir, |
229 $dir = substr $dir, |
230 length $ONCE_VAR; # make it relative to $ONCE_VAR |
230 length $VAR; # make it relative to $VAR |
231 |
231 |
232 # FIXME: use the rx* patterns from above |
232 # FIXME: use the rx* patterns from above |
233 $dir =~ m{/(?<expires>[a-z\d]{6})-(?<hash>[a-z\d]+)-(?<delete>.)}i |
233 $dir =~ m{/(?<expires>[a-z\d]{6})-(?<hash>[a-z\d]+)-(?<delete>.)}i |
234 or next; |
234 or next; |
235 my ($hash, $expires, $delete) = @{+}{qw/hash expires delete/}; |
235 my ($hash, $expires, $delete) = @{+}{qw/hash expires delete/}; |