Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Perl/CGI Uploading file to the server using a upload hook is failing intermittently

by prantikd (Novice)
on Jan 12, 2012 at 10:57 UTC ( #947516=perlquestion: print w/replies, xml ) Need Help??

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

Hi,

While uploading the file on to the server, we want to show a progress bar of the file upload. For that we are using CGI upload hook to read the length of the buffer uploaded from the browser.

For some cases, it intermittently fails to read the buffer and when it fails to do so, we get an empty file handle i.e., in my attached example at line 23 my $upload_fh = $q->upload('file');, I get the $upload_fh = undef and it never goes in the sub hook.

Moreover, when this problem occurs, I donít get the apache temp filename location, i.e., line 31 print LOG "temp filename = " . $q->tmpFileName($filename) . "\n"; returns nothing. In all the successful cases, I get the temp filename as (/usr/tmp/CGITemp<some_number>).

Also, if I donít use the upload hook, I never get this scenario and the file upload never fails. I am not sure if I am missing anything here and not able to figure out why is it failing intermittently? I am using the latest CGI version 3.59. Any inputs on this context would be very helpful.

#!/usr/bin/perl BEGIN { push @INC, split(":", $ENV{PERL5LIB}); } $|++; use strict; use CGI; use DBI; use File::stat; use File::Path; use FileManager; use JSON::XS; use Data::Dumper; use POSIX qw(ceil floor); use GetDBHandle qw(:DEFAULT); use ParseBrixConfig; my $q = new CGI(\&hook); my $filename = $q->param('file'); my $upload_fh = $q->upload('file'); my $MY_HOME = $ENV{MY_HOME}; my $log_path = $MY_HOME . "/log"; my $state_dir = $MY_HOME . "/apache/htdocs/state"; open LOG, ">> $log_path/fileUpload.log"; print LOG "server process id = " . $$ . "\n"; print LOG "temp filename = " . $q->tmpFileName($filename) . "\n"; print LOG "apache file info = " . Dumper($q->uploadInfo($filename)) . +"\n"; print LOG "upload fh = " . ref($upload_fh) . "\n"; print LOG "upload fh size = " . Dumper(stat($upload_fh)->size) . "\n"; my $config = parse_brix_config($ENV{MY_HOME}."/conf/system.conf"); my $db_name = $config->{global}{db_name}; my $db_string = 'dbi:Oracle:' . $db_name; my ($cust_db_user, $cust_db_pass) = get_db_handle( r => $q, config => +$config, req_type = +> 'cgi' ); # open the customer dbh handle my $dbh = db_connect( credentials => { db_user => $cust_db_user, db_password => $cust_db_pass, db_string => $db_string } ); die "Could not get the dbh handle. Something is wrong .... cust_db_use +r = [$cust_db_user], cust_db_pass = [$cust_db_pass], db_string = [$db +_string]\n" if not defined $dbh; # start file processing my ($progressTempFile, $savedFileName) = $ENV{QUERY_STRING} =~ /filePr +ogressTemp=(.*?)&savedFileName=(.*)/; print LOG "progressTempFile = $progressTempFile\n"; print LOG "savedFileName = $savedFileName\n"; # get the uploaded file handle my $file_saved_location = get_saved_file_location(dbh => $dbh); # If directory not exists then create it and give permission if (!-d $file_saved_location) { `mkdir $file_saved_location`; `chmod 777 $file_saved_location`; } my $file_size = stat($upload_fh)->size; my $file_path = "$file_saved_location$savedFileName"; # create actual +file path print LOG "file_path = $file_path\n"; my %final_data = (); my $buffer = 0; eval { # read the actual temp file and store the data in the real locatio +n open (FH, ">$file_path"); while (my $length = sysread($upload_fh, $buffer, 262144)) { #256KB + chunk at a time syswrite(FH, $buffer, $length); } close FH; # mark 100% in the progress temp file so that it shows 100% on the + progress bar if (-e "$state_dir/$progressTempFile") { open (COUNTER, ">> $state_dir/$progressTempFile"); print COUNTER "100"; close COUNTER; } }; if($@) { print STDERR "LOG: The EXFOConnect system encountered an error. Pl +ease Contact System Administrator: $@"; } if(-e $file_path) { %final_data = ( success => JSON::XS::true, success_status => 1, file_size => $file_size, saved_file_path => $file_path, ); }else { %final_data = ( success => JSON::XS::false, message => "The EXFOConnect system encountered an error. Pleas +e Contact System Administrator.", success_status => 0 ); } $dbh->commit; $dbh->disconnect; print LOG "---------------------------------------------------\n"; close LOG; print "Content-Type: text/html\n\n"; print encode_json(\%final_data); ################################# ## This is the handler to read the bytes of file uploaded ################################# sub hook { my ($filename, $buffer, $bytes_read, $data) = @_; $bytes_read ||= 0; my $MY_HOME = $ENV{MY_HOME}; my $log_path = $MY_HOME . "/log"; my $state_dir = $MY_HOME . "/apache/htdocs/state"; my ($fileProgressTemp) = $ENV{QUERY_STRING} =~ /fileProgressTemp=( +.*?)&savedFileName=(.*)/; # calculate percentage of uploaded file and save it. # this will be read by a ajax request to show the percentage compl +ete. open(COUNTER, ">> $state_dir/$fileProgressTemp"); my $per = 0; if ($ENV{CONTENT_LENGTH} > 0) { $per = ($bytes_read * 100) / $ENV{CONTENT_LENGTH}; } print COUNTER ceil($per) . "\n"; close(COUNTER); } exit;

Replies are listed 'Best First'.
Re: Perl/CGI Uploading file to the server using a upload hook is failing intermittently
by Anonymous Monk on Jan 12, 2012 at 12:16 UTC

      If you want a module that is similar (but somewhat more lenient) to WashFilename, see Text::CleanFragment. It munges filenames to match

      /^[-._A-Za-z0-9]*$/

      or, to be more exact

      /^([A-Za-z0-9]([-._A-Za-z0-9]*[A-Za-z0-9])?$/

      Instead of removing umlauts etc., it cleans them up by unaccenting or transliterating them.

      Personally, I don't like to create files on a system with a filename supplied by the user, so I mostly create filenames using the SHA-256 (or whatever) and have a database mapping the file id to the user-specified filename. This helps avoiding all those pesky injections.

      You said, "It is completely unclear why you're bothering with the upload hook, so get rid of it :)"

      The OP said, "While uploading the file on to the server, we want to show a progress bar of the file upload. For that we are using CGI upload hook to read the length of the buffer uploaded from the browser."

      So how does using File::Copy allow them to show the progress of the upload? From what I can tell, it won't.

        So how does using File::Copy allow them to show the progress of the upload? From what I can tell, it won't.

        File::Copy takes care of copying the file, with binmode, error checking and everything :)

        If you still need an upload hook, just pass to  CGI->new like you had before

Re: Perl/CGI Uploading file to the server using a upload hook is failing intermittently
by Anonymous Monk on Jan 13, 2012 at 02:33 UTC

    If uploads failed, CGI stores errors in cgi_error, so if you used fatalsToBrowser you can simply  die $q->cgi_error

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://947516]
Approved by moritz
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (6)
As of 2019-09-19 22:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The room is dark, and your next move is ...












    Results (253 votes). Check out past polls.

    Notices?