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