View of /branches/gage_dev/webwork2/lib/WeBWorK/Upload.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/Upload.pm,v 1.7 2006/01/25 23:13:51 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;