Re: 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;
}
[download]

Comment on Re: Perl/CGI Uploading file to the server using a upload hook is failing intermittently Select or Download Code

Replies are listed 'Best First'.
Re^2: Perl/CGI Uploading file to the server using a upload hook is failing intermittently by Corion (Patriarch) on Jul 04, 2019 at 07:24 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]$/` [download] or, to be more exact `/^([A-Za-z0-9]([-._A-Za-z0-9][A-Za-z0-9])?$/` [download] 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.	[reply] [d/l] [select]
Re^2: Perl/CGI Uploading file to the server using a upload hook is failing intermittently by Mr. Muskrat (Canon) 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.	[reply]
Re^3: Perl/CGI Uploading file to the server using a upload hook is failing intermittently by Anonymous Monk on Jan 13, 2012 at 02:32 UTC
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	[reply] [d/l]
Re^4: Perl/CGI Uploading file to the server using a upload hook is failing intermittently by SergioQ (Beadle) on Feb 14, 2022 at 03:39 UTC
The answer was simple, it was a totally my bad error: I left method="post" enctype="multipart/form-data" out of my form declaration in the HTML page. Once I did some debugging I realized that `my $fileHandle = $q->upload('filename');` returned NULL, with no error.	[reply] [d/l]


There's more than one way to do things
	PerlMonks