Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

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 ( #947528=note: print w/ replies, xml ) Need Help??


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

Any inputs on this context would be very helpful.

See Re: Insecure dependency in open while running with -T switch and use taint

If you  use File::Path; , actually use it, don't shell out to mkdir

If you  use CGI; then don't look at QUERY_STRING, use CGI or die;

It is completely unclear why you're bothering with the upload hook, so get rid of it :) You can use File::Copy for CGI upload, like this

#!/usr/bin/perl -- use constant DEBUG => !!( 0 || $ENV{PERL_DEBUG_MYAPPNAME} ); use CGI::Carp qw( fatalsToBrowser ); use CGI; # to avoid those pesky 500 errors BEGIN { CGI::Carp::set_message( sub { print "<h1>something broke, we know what it is, thank you, + try again later</h1>\n"; if (DEBUG) { # secrets print '<p>', CGI->escapeHTML(@_), '</p>'; } } ); } ## end BEGIN use strict; use warnings; use Data::Dumper (); use File::Copy qw' copy '; Main( @ARGV ); exit( 0 ); sub Main { #~ return DebugCGI(); # generic, env.cgi return SaveUploadsTo( CGI->new, [qw' file otheruploadfile andAnother '], '/destination/dir/where/uploads/end/up', ); } ## end sub Main sub SaveUploadsTo { my( $cgi, $uploadFields , $destDir ) = @_; chdir $destDir or die "Cannot chdir to upload destination directory: $!\n"; print $cgi->header; for my $field ( @{ $uploadFields } ){ my $filename = $cgi->param( $field ); my $tmpfilename = $cgi->tmpFileName( $filename ); $filename = WashFilename( $filename ) ; my $destFile = File::Spec->catfile( $destDir, $filename ); copy( $tmpfilename, $destFile ) or die "Copy to ( $destFile ) failed: (( $! ))(( $^E ))"; print "<p>Sucessfully uploaded ", CGI->escapeHTML( $filename ), " thanks</p>\n"; } print "<P>done processing uploads</p>\n"; } ## end sub SaveUploadsTo sub DebugCGI { my $cgi = CGI->new; print $cgi->header(); # Write HTTP header print $cgi->start_html, $cgi->b( rand time, ' ', scalar gmtime ), '<table border="1" width="%100"><tr><td>', $cgi->Dump, '</td>', '<td><div style="white-space: pre-wrap; overflow: scroll;">', $cgi->escapeHTML( DD($cgi) ), '</div></td></tr></table>', CGI->new( \%ENV )->Dump, $cgi->end_html; } ## end sub DebugCGI sub WashFilename { use File::Basename; my $basename = basename( shift ); # untainted , only use a-z A-Z 0-9 and dot $basename = join '', $basename =~ m/([.a-zA-Z0-9])/g; # basename is now, hopefully, file.ext ## so to ensure uniqueness, we adulterate it :) my $id = $$.'-'.time; my( $file, $ext ) = split /\./, $basename, 2 ; return join '.', grep defined, $file, $id, $ext; } ## end sub WashFilename sub DD { scalar Data::Dumper->new( \@_ )->Indent(1)->Useqq(1)->Dump; }


Comment on Re: Perl/CGI Uploading file to the server using a upload hook is failing intermittently
Select or Download Code
Re^2: Perl/CGI Uploading file to the server using a upload hook is failing intermittently
by Mr. Muskrat (Abbot) on Jan 12, 2012 at 19:22 UTC

    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

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (8)
As of 2014-12-19 22:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (94 votes), past polls