Parent Directory
| 
Revision Log
Finished Upload module. See POD.
Added sendFile routine to ContentGenerator. To use, store a hash
reference in $self->{sendFile} containing keys:
source: full path to file to send
type: content type of file to send
name: file name to suggest to client
This must be done BEFORE the HTTP header is sent, i.e. in
pre_header_initialize. It will not work is &go or &header is overridden.
1 ################################################################################ 2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project 3 # $Id$ 4 ################################################################################ 5 6 package WeBWorK::Upload; 7 8 =head1 NAME 9 10 WeBWorK::Upload - store uploads securely across requests. 11 12 =head1 SYNOPSIS 13 14 Given C<$u>, an Apache::Upload object 15 16 my $upload = WeBWorK::Upload->store($u, 17 dir => $ce->{webworkDirs}->{DATA} 18 ); 19 my $id = $upload->id; 20 my $hash = $upload->hash; 21 22 Later... 23 24 my $upload = WeBWorK::Upload->retrieve($id, $hash, 25 dir => $ce->{webworkDirs}->{uploadCache} 26 ); 27 my $fh = $upload->fileHandle; 28 my $path = $upload->filePath; 29 30 # get rid of the upload -- $upload is useless after this! 31 $upload->dispose; 32 33 # ...or move it somewhere before disposal 34 $upload->disposeTo($path); 35 36 =head1 DESCRIPTION 37 38 WeBWorK::Upload provides a method for securely storing uploaded files until such 39 time as they are needed. This is useful for situations in which an upload cannot 40 be handled by the system until some later request, such as the case where a user 41 is not yet authenticated, and a login page must be returned. Since a file upload 42 should not be sent back to the client and then uploaded again with the user 43 provides his login information, some proxy must be sent in its place. 44 WeBWorK::Upload generates a unique ID which can be used to retrieve the original 45 file. 46 47 =cut 48 49 use strict; 50 use warnings; 51 use Carp qw(croak); 52 use Data::UUID; # this is probably overkill ;) 53 use Digest::MD5 qw(md5_hex); 54 use File::Copy qw(copy move); 55 56 =head1 STORING UPLOADS 57 58 Uploads represented as Apache::Uploads objects can be stored in an upload cache 59 and later retrieved, given the proper ID and hash. The hash is used to confirm 60 the authenticity of the ID. 61 62 =head2 CONSTRUCTOR 63 64 =over 65 66 =item store($u, %options) 67 68 Stores the Apache::Upload C<$u> securely. The following keys must be defined in 69 %options: 70 71 dir => the directory in which to store the uploaded file 72 73 =cut 74 75 sub store { 76 my ($invocant, $apacheUpload, %options) = @_; 77 78 croak "no Apache::Upload specified" unless $apacheUpload; 79 80 # generate UUID 81 my $ug = new Data::UUID; 82 my $uuid = $ug->create_str; 83 84 # generate one-time secret 85 my $secret = sprintf("%X"x4, map { int rand 2**32 } 1..4); 86 87 # generate hash from $uuid and $secret 88 my $hash = md5_hex($uuid, $secret); 89 90 # get information about uploaded file 91 my $realFileName = $apacheUpload->filename; 92 my $fh = $apacheUpload->fh; 93 94 my $infoName = "$uuid.info"; 95 my $infoPath = "$options{dir}/$infoName"; 96 97 my $fileName = "$uuid.file"; 98 my $filePath = "$options{dir}/$fileName"; 99 100 # write info file 101 open my $infoFH, ">", $infoPath 102 or die "failed to write upload info file $infoPath: $!"; 103 print $infoFH "$realFileName\n$secret\n"; 104 close $infoFH; 105 106 # copy uploaded file 107 copy($fh, $filePath); # the file name is a secret! 108 109 return bless { 110 uuid => $uuid, 111 dir => $options{dir}, 112 hash => $hash, 113 realFileName => $realFileName, 114 }, ref($invocant) || $invocant; 115 } 116 117 =item id 118 119 Return the upload's unique ID, or an undefiend value if the upload is not valid. 120 121 =cut 122 123 sub id { 124 my ($self) = @_; 125 my $uuid = $self->{uuid}; 126 my $dir = $self->{dir}; 127 128 my $infoName = "$uuid.info"; 129 my $infoPath = "$dir/$infoName"; 130 131 # make sure info file still exists (i.e. the file hasn't been disposed of) 132 return unless -e $infoPath; 133 134 return $uuid; 135 } 136 137 =item hash 138 139 Return the upload's hash, or an undefiend value if the upload is not valid. 140 141 =cut 142 143 sub hash { 144 my ($self) = @_; 145 my $uuid = $self->{uuid}; 146 my $dir = $self->{dir}; 147 my $hash = $self->{hash}; 148 149 my $infoName = "$uuid.info"; 150 my $infoPath = "$dir/$infoName"; 151 152 # make sure info file still exists (i.e. the file hasn't been disposed of) 153 return unless -e $infoPath; 154 155 return $hash; 156 } 157 158 =back 159 160 =head1 RETRIEVING UPLOADS 161 162 An upload stored in the upload cache can be retrieved by supplying its ID and 163 hash (accessible from the above C<id> and C<hash> methods, respectivly. The file 164 can then be accessed by name or file handle, moved, and disposed of. 165 166 =head2 CONSTRUCTOR 167 168 =over 169 170 =item retrieve($id, $hash, %options) 171 172 Retrieves the Apache::Upload referenced by C<$id> and C<$hash>. The following 173 keys must be defined in %options: 174 175 dir => the directory in which to store the uploaded file 176 177 =cut 178 179 sub retrieve { 180 my ($invocant, $uuid, $hash, %options) = @_; 181 182 croak "no upload ID specified" unless $uuid; 183 croak "no upload hash specified" unless $hash; 184 185 my $infoName = "$uuid.info"; 186 my $infoPath = "$options{dir}/$infoName"; 187 188 my $fileName = "$uuid.file"; 189 my $filePath = "$options{dir}/$fileName"; 190 191 croak "no upload matches the ID specified" unless -e $infoPath; 192 193 # get real file name and secret from info file 194 open my $infoFH, "<", $infoPath 195 or die "failed to read upload info file $infoPath: $!"; 196 my ($realFileName, $secret) = <$infoFH>; 197 close $infoFH; 198 199 # jesus christ 200 chomp $realFileName; 201 chomp $secret; 202 203 # generate correct hash from $uuid and $secret 204 my $correctHash = md5_hex($uuid, $secret); 205 206 #warn __PACKAGE__, ": secret is $secret\n"; 207 #warn __PACKAGE__, ": correctHash is $correctHash\n"; 208 209 croak "upload hash incorrect!" unless $hash eq $correctHash; 210 211 # -- you passed the test... -- 212 213 return bless { 214 uuid => $uuid, 215 dir => $options{dir}, 216 hash => $hash, 217 realFileName => $realFileName, 218 }, ref($invocant) || $invocant; 219 } 220 221 =back 222 223 =head2 METHODS 224 225 =over 226 227 =item filename 228 229 Returns the original name of the uploaded file. 230 231 =cut 232 233 sub filename { 234 my ($self) = @_; 235 my $uuid = $self->{uuid}; 236 my $dir = $self->{dir}; 237 my $realFileName = $self->{realFileName}; 238 239 my $infoName = "$uuid.info"; 240 my $infoPath = "$dir/$infoName"; 241 242 my $fileName = "$uuid.file"; 243 my $filePath = "$dir/$fileName"; 244 245 # make sure info file still exists (i.e. the file hasn't been disposed of) 246 return unless -e $infoPath; 247 248 return $realFileName; 249 } 250 251 =item fileHandle 252 253 Return a file handle pointing to the uploaded file, or an undefiend value if the 254 upload is not valid. Suitable for reading. 255 256 =cut 257 258 sub fileHandle { 259 my ($self) = @_; 260 my $uuid = $self->{uuid}; 261 my $dir = $self->{dir}; 262 263 my $infoName = "$uuid.info"; 264 my $infoPath = "$dir/$infoName"; 265 266 my $fileName = "$uuid.file"; 267 my $filePath = "$dir/$fileName"; 268 269 # make sure info file still exists (i.e. the file hasn't been disposed of) 270 return unless -e $infoPath; 271 272 open my $fh, "<", $filePath 273 or die "failed to open upload $filePath for reading: $!"; 274 return $fh; 275 } 276 277 =item filePath 278 279 Return the path to the uploaded file, or an undefiend value if the upload is not 280 valid. 281 282 If you use this, bear in mind that you must not dispose of the upload (either by 283 moving or deleting the uploaded file or calling the C<dispose> method). If you 284 wish to move the file, use the C<disposeTo> method instead. 285 286 =cut 287 288 sub filePath { 289 my ($self) = @_; 290 my $uuid = $self->{uuid}; 291 my $dir = $self->{dir}; 292 293 my $infoName = "$uuid.info"; 294 my $infoPath = "$dir/$infoName"; 295 296 my $fileName = "$uuid.file"; 297 my $filePath = "$dir/$fileName"; 298 299 # make sure info file still exists (i.e. the file hasn't been disposed of) 300 return unless -e $infoPath; 301 302 return $filePath; 303 } 304 305 =item dispose 306 307 Remove the file from the upload cache. Returns true if the upload was 308 successfully destroyed, or an undefiend value if the upload is not valid. 309 310 =cut 311 312 sub dispose { 313 my ($self) = @_; 314 my $uuid = $self->{uuid}; 315 my $dir = $self->{dir}; 316 317 my $infoName = "$uuid.info"; 318 my $infoPath = "$dir/$infoName"; 319 320 my $fileName = "$uuid.file"; 321 my $filePath = "$dir/$fileName"; 322 323 # make sure info file still exists (i.e. the file hasn't been disposed of) 324 return unless -e $infoPath; 325 326 unlink $infoPath; 327 unlink $filePath; 328 329 return 1; 330 } 331 332 =item disposeTo($path) 333 334 Remove the file from the upload cache, and move it to C<$path>. Returns true if 335 the upload was successfully moved, or an undefiend value if the upload is not 336 valid. 337 338 =cut 339 340 sub disposeTo { 341 my ($self, $newPath) = @_; 342 my $uuid = $self->{uuid}; 343 my $dir = $self->{dir}; 344 345 croak "no path specified" unless $newPath; 346 347 my $infoName = "$uuid.info"; 348 my $infoPath = "$dir/$infoName"; 349 350 my $fileName = "$uuid.file"; 351 my $filePath = "$dir/$fileName"; 352 353 # make sure info file still exists (i.e. the file hasn't been disposed of) 354 return unless -e $infoPath; 355 356 unlink $infoPath; 357 move($filePath, $newPath); 358 } 359 360 =back 361 362 =head1 AUTHOR 363 364 Written by Sam Hathaway, sh002i at math.rochester.edu. Based on the original 365 WeBWorK::Upload module by Dennis Lambe, Jr., malsyned at math.rochester.edu. 366 367 =cut 368 369 1; 370 371 __END__ 372 373 use Data::UUID; 374 use MD5 qw(); 375 use WeBWorK::Constants qw(SECRET); 376 377 # This package allows a file to be reliably cached on disk and replaced with 378 # a string that universally and unforgeably represents that file, and then 379 # retrieved later given that string. 380 381 sub store_upload {} 382 383 sub retrieve_upload {} 384 385 sub new { 386 unless (SECRET) { 387 die "A secret has not been set in WeBWorK::Constants for this server."; 388 } 389 my $invocant = shift; 390 my $class = ref($invocant) || invocant; 391 my $self = { 392 basedir => shift; # The directory into which to place the spool file 393 uploadObject => shift; # The Apache::Upload object to deal with 394 }; 395 396 my $ug = Data::UUID->new; # UUID Generator/Handler 397 my $uuid = $ug->generate; # Unique identifier for this file, guaranteed to be unique until 3400AD 398 my $uuid_as_string = $ug->to_string($uuid); 399 my $mac = MD5->hexhash(SECRET . MD5->hexhash(SECRET . $uuid_as_string); # Message Authentication Check. As long as SECRET stays secret, 400 401 402 $self->{ 403 $self->{MAC} = MD5->hexhash(SECRET . MD4->hexhash(SECRET . $self{UUID}-> # Message Authentication Check - An unforgeable checksum 404 }; 405 } 406 407 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |