CGI upload creates empty file

Question

Hi I'm trying to upload a file using CGI and although the CGI script runs, the file that is created is empty.

I have a html file which gets the file name and passes it to a cgi script:

<html>
<body>

<form enctype="multipart/form-data" action="cgi-bin/upload.pl" method="POST">
<input type="FILE" name="file">
<input type="submit">
</form>

</body>
</html>

The cgi script is as follows:

#!/usr/bin/perl -w

use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI;

print "Content-type: text/html\n\n";

my $cgi = new CGI;
my $dir = 'sub';

my $name = $cgi->param('file');
print "name: $name <br />\n";
open(LOCAL, ">$dir/$name") or die "error: failed to open $dir/$name\n";
my $file_handle = $cgi->upload('file');
die "file_handle not defined\n" unless(defined($file_handle));
while(<$file_handle>) {
    print $_;
    print LOCAL $_;
}
close($file_handle);
close(LOCAL);

print "done\n";

The cgi script runs OK, produces no warnings, manages to create a local file and correctly gets the remote file name. However, the script appears not to read any data from the file or write any data into the local file which is empty.

I'm definitely uploading a file that contains multiple lines of data but the output of the cgi script is as follows:

   name: tmp.txt 
   done

Any help greatly appreciated...

Answer 1

You might want to try using the binmode command on the FH.

Here's a Perl script that I use as a starting point for a CGI form that uploads files (displays the form and does the upload):

#!/usr/bin/perl

use strict;
use warnings;

use POSIX;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser set_message);

use Upload;

# Constants
my $FILE_DIR_INTERNAL = 'Z:\webroot\tmp';

# Variables
my $ACTION = param('action') || "";

if (! $ACTION) { UploadForm() }
elsif ($ACTION eq "UploadFile") {
  my $file = UploadFile($FILE_DIR_INTERNAL, 1);
  print "File uploaded to $file\n<pre>";
  open(F, "$file");
  while(<F>) { print }
  close(F);
}

And here's the Perl module used by that script:

package Upload;

use strict;
use warnings;
use POSIX;
use File::Copy;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser); # supposed to echo STDERR to browser, too

use Exporter;
our $VERSION = do{ q$Revision: 1.5 $ =~ /(\d+)\.(\d*)([^ ]*)/; sprintf "%d.%02d%s", $1, $2, $3; };
our @ISA = qw(Exporter);
our @EXPORT = qw(UploadForm UploadFile);


my $FILE_UPLOAD_PARAM = "fileUploaded";

# *************************************************************************
# FUNCTION: UploadForm
# ARGUMENTS:    
# RETURNS:  
# NOTES:    This subroutine displays the upload form.
# *************************************************************************
sub UploadForm {


  print start_center;
  print p("Upload a file from your computer:");

  # Normally, I use the "get" method for forms (params show up in URL),
  # but "post" is required for uploading files!
  # Using "post" also requires that we pass parameters thru the hidden()
  # commands down below, instead of in the URL.
  print start_multipart_form({-method=>"post", -action=>script_name});
  print filefield($FILE_UPLOAD_PARAM,"",50) . "\n";

  # Hidden parameters are "sticky", so modify the existing "action" param,
  # before trying to insert a new hidden "action" param.
  # If you don't, CGI.pm will re-use the current "action" param.
  param("action", "UploadFile");
  print hidden("action") . "\n";

  print p(submit("", "Upload File"));
  print end_form;

  print end_center;

}

# *************************************************************************
# FUNCTION: UploadFile
# ARGUMENTS:    
# RETURNS:  
# NOTES:    This subroutine handles data "posted" thru the form
#       created in UploadForm().
# *************************************************************************
sub UploadFile {

  my $dir = shift || die "ERROR!  No arg passed to UploadFile().\n";
  my $overwrite = shift || 0;

  my $TEMP_FH;

  # The upload() function returns the filename and a file handle.  See CGI.pm.
  $_= $TEMP_FH = upload($FILE_UPLOAD_PARAM);

  # What do all the regexes do?  I wrote them, but I forgot.  I think they
  # strip off any path information (common in IE!) to get just the filename.
  s/\w://;
  s/([^\/\\]+)$//;
  $_ = $1;
  s/\.\.+//g;
  s/\s+//g;
  my $filename = $_;
  my $serverFullFilename = "$dir/$filename";

  if (! $filename) {
    DisplayErrorPage("Illegal filename: '$filename'");
  }

  if ((! $overwrite) && (-e $serverFullFilename)) {
    die "Unable to upload file.  File '$filename' already exists.";
  }

  open(SERVER_FH,">$serverFullFilename") || die "Error opening $filename for writing.";
  binmode SERVER_FH;

  # Copy the file from the temp dir to the final location.
  while (<$TEMP_FH>) {
    print SERVER_FH;
  }

  close(SERVER_FH);
  close($TEMP_FH);

  if ((stat $serverFullFilename)[7] <= 0) {
    unlink $serverFullFilename;
    die "Unable to upload file '$filename'.  This is usually due to the user specifying an invalid or unreadable file on the user's computer.";
  }

  return $serverFullFilename;
} 

return 1;

Forgive any inconsistencies, as I had to cut out some site-specific stuff, but if I trimmed it all correctly, that should work "out of the box"