dannoura has asked for the wisdom of the Perl Monks concerning the following question:

I have a script I want to use to upload files to a website. I have 2 problems with it:

The HTML is:

<FORM ENCTYPE="multipart/form-data" ACTION="../cgi-bin/upload.pl" METH
+OD="POST">
Please select a file to upload: <BR> 
<INPUT TYPE="FILE" NAME="file">
<p>
<INPUT TYPE="submit">
</FORM>

[download]

And the code is:

#! c:/Perl/bin/Perl.exe -wT

# Script to upload file. This script is tied to upload.html
use strict;
use CGI;

my $query = CGI->new();

my $fn = $query->param ('file');
my $fh = $query->upload ('file');
($fn)=($fn=~/^.+\\(.+)/);
my $size=-s $fh;
my $max_size=100;

print $query->header( "text/html" ),
      $query->start_html(-title => "Upload Test");
if ($size<$max_size*1024) { #This file size allowed
    if (open FH, ">$fn") { # Open file
        while (<$fh>) {
            print FH;
            }
        if (check_filesize((-s FH), $size)) { # If all file copied to 
+server
           print $query->p("File uploaded succesfully");
           } else {
           print $query->p("There was a problem uploading your 
           file. Please ").a({-href=>"localhost/upload.html"}, "try ag
+ain");
           }
        } else {
        print $query->p("There was a problem uploading your 
           file. Please ").a({-href=>"localhost/upload.html"}, "try ag
+ain");
        }
    } else {
    print $query->p("Sorry, this file is too large. Maximum size allow
+ed is ", $max_size, "kb");
    } 
        
print $query->end_html;

sub check_filesize { # Check if upload file size is approximately equa
+l to the file written
    my ($up_file, $down_file)=@_;
    return 1 if ((sprintf "%d", $up_file/1024)==(sprintf "%d", $down_f
+ile/1024) ||
       (sprintf "%d", $up_file/1024)==(sprintf "%d", $down_file/1024)+
+1 ||
       (sprintf "%d", $up_file/1024)==(sprintf "%d", $down_file/1024)-
+1);
    return 0
    }

[download]

I'm using perl 5.8.0 with Apache 2.0.45 on WinXP.

Update: It seems that fizbin is right. The upload gets interrupted at some point. I can't find anything to indicate why in the apache error log. When I pass text files it's no problem (although I still have the CGItemp files), but if I upload pictures they come up corrupted. Why is this happening? Do I have to use binmode?

-----------------------------------

Any comments about coding style are welcome.

Replies are listed 'Best First'.
Re: upload on different browsers
by fizbin (Chaplain) on Jul 16, 2004 at 17:48 UTC
    Offhand, without investigating too closely, I'd say that your problem is here: 
    ($fn)=($fn=~/^.+\\(.+)/);

    [download]
    What you appear to be trying to do is take the filename and strip off any leading directory spec., leaving only the last portion. But what if there isn't any directory, and firefox is just sending the filename? Then $fn ends up as undef, which could mean that your open statement a few lines down fails badly.

    I'd change that line to: 

    $fn =~ s{^.*[/\\]}{};

    [download]
    Not only will this still leave the variable defined if it doesn't include a directory spec., it's a bit clearer to someone reading the code that what you want to do here is strip off any path portion of the filename, leaving only the actual file. 
    --
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/

    [download]
[reply]
[d/l]
[select]

      Thanks, that works (although I can't figure out why. If your reasoning is correct than IE shouldn't have accepted it either. Oh well). Thanks also for streamlining the sub. As for the last issue: it doesn't help to close FH;. I'm using the line

      if (check_filesize((-s FH), $size))

      to check if all the file got copied, so I have to have FH open after the while loop. Adding close FH; at the end of the script still doesn't do the trick. I still have a CGItemp file after the upload. Any othe ideas?

[reply]
[d/l]
[select]
        At this point, I think your script is still erroring out somewhere, and the way I'd check where is to find the Apache error logfile and look at it. 
        --
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/

        [download]
[reply]
[d/l]

      While I agree that the code is clearer with a substitution rather than capturing stuff in $1, the advantage of the latter is that it untaints the input, and it's definitely preferable for web scripts to run in taint mode. Something like this should work:

      ($fn) = ($fn =~ m#([^/\\]+)$#;

      However for getting the basename of a path I'd tend to use File::Basename — though that doesn't play well with the desire to untaint ...

      Smylers

[reply]
[d/l]
[select]
      Another thing to note is the CGI.pm has an inbuilt upload limit, its stored in the $CGI::POST_MAX variable. <snip> An attempt to send a POST larger than $POST_MAX bytes will cause param() to return an empty CGI parameter list. You can test for this event by checking cgi_error(), either after you create the CGI object or, if you are using the function-oriented interface, call <param()> for the first time. If the POST was intercepted, then cgi_error() will return the message "413 POST too large". </snip> http://www.perldoc.com/perl5.8.4/lib/CGI.html HTH
[reply]
Re: upload on different browsers
by fizbin (Chaplain) on Jul 16, 2004 at 17:58 UTC
    Oh, and totally unrelated to your question, but I just can't let that check_filesize routine stand as is: 
    sub check_filesize { # Check if upload file size is approximately equa
+l to the file written
    my ($up_file, $down_file)=@_;
    return (abs ( int($up_file/1024) - int($down_file/1024) ) <= 1);
}

    [download]
    --
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/

    [download]
[reply]
[d/l]
[select]
Re: upload on different browsers
by fizbin (Chaplain) on Jul 16, 2004 at 18:05 UTC
    I know, I'm full of replies.

    About your second question - those wierd file names - what I think is happening is that your script is failing to complete on the server. During file upload, CGI.pm creates temporary files as you mention to hold the data while the script does something with it. Once the script completes, these files are deleted, but if your script is erroring out, then the files could stick around.

    I suggest that you look in the apache error log, but if I had to make a guess I'd say that the code -s FH is causing trouble, and you really want to say -s $fn, though you'd also want to say close FH; immediately after the while loop. 

    --
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/

    [download]
[reply]
[d/l]
[select]
Re: upload on different browsers
by Anonymous Monk on Jul 17, 2004 at 18:38 UTC
    Yes, binmode is required for Windows, at least when I did this on W2K with IIS. 

    my $file = $req->param($inputfieldname);
my $fh = $req->upload($inputfieldname);
if (open(OUTFILE, ">$c{dir}{tmp}/$file")) {
  binmode(OUTFILE); # Windows only
  while (<$fh>) {
   print OUTFILE;
  }
  close (OUTFILE);
}

    [download]
[reply]
[d/l]
      binmode is always required
[reply]

Back to Seekers of Perl Wisdom