in reply to File Upload - What Next?

Here is a complete example from the O'Reilly book "CGI Programming" aka The Rat Book. I recommend this book to you. This script is public domain and freely available so I'm sure this does not breach copyright.

HTML <form action="upload.cgi" method="POST" enctype="multipart/form-data"> <p>Please choose a file to upload: <input type="file" name="file"> <p>Please enter a name for this file: <input type="text" name="filename"> </form> use strict; use CGI; use Fcntl qw( :DEFAULT :flock ); use constant UPLOAD_DIR => "/usr/local/apache/data/uploads"; use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 1_048_576; # Limit each upload to + 1 MB use constant MAX_DIR_SIZE => 100 * 1_048_576; # Limit total uploads +to 100 MB use constant MAX_OPEN_TRIES => 100; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; my $q = new CGI; $q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_err +or ); my $file = $q->param( "file" ) || error( $q, "No file receive +d." ); my $filename = $q->param( "filename" ) || error( $q, "No filename ent +ered." ); my $fh = $q->upload( "file" ); my $buffer = ""; if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) { error( $q, "Upload directory is full." ); } # Allow letters, digits, periods, underscores, dashes # Convert anything else to an underscore $filename =~ s/[^\w.-]/_/g; if ( $filename =~ /^(\w[\w.-]*)/ ) { $filename = $1; } else { error( $q, "Invalid file name; files must start with a letter or n +umber." ); } # Open output file, making sure the name is unique until ( sysopen OUTPUT, UPLOAD_DIR . "/$filename", O_CREAT | O_RDWR | +O_EXCL ) { $filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e; $1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." ); } # This is necessary for non-Unix systems; does nothing on Unix binmode $fh; binmode OUTPUT; # Write contents to output file while ( read( $fh, $buffer, BUFFER_SIZE ) ) { print OUTPUT $buffer; } close OUTPUT; print $q->header( "text/plain" ), "File received."; sub dir_size { my $dir = shift; my $dir_size = 0; # Loop through files and sum the sizes; doesn't descend down subdi +rs opendir DIR, $dir or die "Unable to open $dir: $!"; while ( readdir DIR ) { $dir_size += -s "$dir/$_"; } return $dir_size; } sub error { my( $q, $reason ) = @_; print $q->header( "text/html" ), $q->start_html( "Error" ), $q->h1( "Error" ), $q->p( "Your upload was not procesed because the following e +rror ", "occured: " ), $q->p( $q->i( $reason ) ), $q->end_html; exit; }

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

Replies are listed 'Best First'.
Re: Re: File Upload - What Next?
by Thathom (Acolyte) on Jul 06, 2001 at 10:48 UTC
    Thanks my friend!!
      Ok, there WAS a problem with this script, but thanks to various people (you know who you are) it now works. Im sure there are scurity issues and all that but it works:) The only one problem i still have is that i get an internal server error when the file size is too big. Must I do some code checking the MAX FILE size or is that what the $CGI: : POST_MAX line is suppose to do for me? Heres the form......
      <FORM ENCTYPE="multipart/form-data" ACTION="the.cgi" METHOD=POST> Var1 : <input type=text name=var1><br> File : <INPUT NAME="file" TYPE="file"><p> <INPUT TYPE="submit" VALUE="Send File"> </FORM>
      and heres the script.........
      #!/usr/bin/perl use CGI; #SET SOME DEFAULT STUFF ################################################### use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 48_576; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; #GET THE VARIABLE AND FILE INFORMATION ################################################### my $query = new CGI; my $filehandle = $query->upload('file'); my $filename = $query->param('file'); my $var1 = $query->param('var1'); #GET FILE NAME BY REMOVING FULL DIRECTORY INFO #eg C:\windows\blah\file.txt ############################################## @pathz = (split(/\\/,$filename)); $fileb = $pathz[$#pathz]; @pathza = (split('/',$fileb)); $filename = $pathza[$#pathza]; #UPLOAD THE FILE TO SELECTED DESTINATION ############################################## open OUTPUT, ">/absolute/path/to/$filename" or die "Can't open: $!"; while (<$filehandle>) { print OUTPUT; } close OUTPUT or die "Can't close: $!"; #DONE ############################################## print "Content-type: text/html\n\n"; print "Sorted!<p>\n"; print "Passed Variable = $var1<p>"; print "File name uploaded was <i>$filename</i><p>\n"; exit;
      Thankyou everyone!, I hope that helps alot of other people too!

        Your suspicion, mentioned in the CB, was that the file's size was causing the problem. That's pretty likely, because you'll notice that CGI::POST_MAX is set to a pretty low number (that value is in *bytes*, by the way ... so as things stand, you'll only allow 48K total in all POSTed data.)

        Other non-miscellany : rewrite this script to work under use strict, you'll thank yourself for it later.

        There are also some modules that can help you make this script more portable; your "filename parsing" routine in fact only handles Win32-style delimiters => \ , but the standard (i.e. already installed) module File::Basename has robust routines that will handle the delimiters used on most operating systems. You'll need to check the $ENV{USER_AGENT} string to make an educated guess about the operating system the client is using. I do believe KM <-- follow that, by the way ... it's my way of indirectly plugging his book -- has a different strategy for dealing with handling uploads for multiple OSes, but I don't recall off the top of my head what it is.

        As far as controlling the error messages, the strategy I like to use is to define a subroutine (I call it bail usually) that will get called in place of die. That way, if something fails I can intercept the error message and give the user something prettier to look at than a 500 error page. If your script is dying *within* calls to functions that are built-in or imported from modules, the usual strategy is to wrap those calls in a block-style eval, and then to check the value of the special variable $@, which will be set to the value of any error thrown by something within the eval block. A toy example:

        eval { die "You're ugly, and your President dresses funny."; } if ($@) { print "Hmm, got an error message that read \"$@\" ... I wonder why? +\n"; }

        Do a super search on "Exception Handling" and read the eval manual page for more info.

        HTH

        perl -e 'print "How sweet does a rose smell? "; chomp ($n = <STDIN>); +$rose = "smells sweet to degree $n"; *other_name = *rose; print "$oth +er_name\n"'
        thx man, nice scipt and it works