Re: File Upload On Windows 8 and Perl

Okay, I've gotten far enough that we should multi-thread a bit, each doing our own thing

I've modified your code; can you save off your version and work with this one a bit?

For me it is failing but I've gotten far enough that it's telling me where and why it's failing so I can chase down environmental issues on my side.

Don't forget to change some of the hard-coded values, such as the CGI script name in the HTML file and output directory in the Perl script, etc.

The updated HTML file:

<!DOCTYPE html>
<html>
  <head>
    <title>My CGI File Upload Test</title>
  </head>
  <body>
    <p>
      <form action="/cgi-bin/photup.pl" method="post" ENCTYPE="multipa
+rt/form-data">
        <table>
          <tr>
            <td align="left"  valign="top" rowspan="9999">&nbsp;&nbsp;
+&nbsp;&nbsp;&nbsp;</td>
            <td align="right" valign="top">Photo File:</td>
            <td align="left"  valign="top" rowspan="9999">&nbsp;&nbsp;
+</td>
            <td align="left"  valign="top"><INPUT TYPE="file" NAME="ph
+oto"></td>
            <td align="left"  valign="top" rowspan="9999">&nbsp;&nbsp;
+&nbsp;&nbsp;&nbsp;</td>
          </tr>
          <tr>
            <td align="right" valign="top">UserId:</td>
            <td align="left"  valign="top"><INPUT TYPE="text" NAME="US
+ER_ID"></td>
          </tr>
          <tr>
            <td align="right" valign="top"></td>
            <td align="left"  valign="top"><INPUT TYPE="SUBMIT" NAME="
+SUBMIT" VALUE="Submit Form"></td>
          </tr>
        </table>
      </form>
    </p>
  </body>
</html>
[download]

The updated Perl script:

#!/usr/bin/perl

# Needed to avoid dependence on C:\TEMP being world read+write
BEGIN { $TempFile::TMPDIRECTORY = './'; }

use strict;

use CGI::Carp qw(fatalsToBrowser);
use CGI qw( :standard);
#use File::Slurp qw( read_file );
#use DBI;
#use Crypt::Lite;
use File::Basename;

my    $TRUE    = 1;
my    $FALSE    = 0;

&header();

#my $retval = eval
{
    ###############################################
    # CGI IN
    print "###############################################\n";
    print "# CGI IN\n";
    my $query = CGI->new;
    print "\$query = [$query]\n";
    my $submit = $query->param('SUBMIT');
    print "\$submit = [$submit]\n";
    my $user_id= $query->param('USER_ID');
    print "\$user_id = [$user_id]\n";

    my $filename = $query->param("photo");
    print "\$filename = [$filename]\n";
    my $safe_filename_characters = "a-zA-Z0-9_.-";
    print "\$safe_filename_characters = [$safe_filename_characters]\n"
+;
    #my $upload_dir = "./images-user";
    my $upload_dir = ".";
    print "\$upload_dir = [$upload_dir]\n";
    #mkdir $upload_dir;    # Just in case
    $CGI::POST_MAX = 1024 * 5000;
    print "\$CGI::POST_MAX = [$CGI::POST_MAX]\n";

    print "###############################################\n";
    if ($user_id eq '') {
        print "\$user_id is blank.  Skipping\n";
#        my $cookie = CGI->new;
#        print "\$cookie = [$cookie]\n";
#        $user_id = $cookie->cookie('TEC_USER_ID');
#        print "\$user_id = [$user_id]\n";
#        my $crypt = Crypt::Lite->new( debug => 0, encoding => 'hex8' 
+);
#        print "\$crypt = [$crypt]\n";
#        my $decrypted = $crypt->decrypt($user_id, $ip_address);
#        print "\$decrypted = [$decrypted]\n";
#        $user_id = $decrypted;
#        print "\$user_id = [$user_id]\n";
    }

    print "####################################################\n";
    print "##################### Main Page ####################\n";
    print "####################################################\n";

    # Start Main Page
    my $abtflg = $FALSE;
    print "\$abtflg = [$abtflg]\n";
    while (!$abtflg)
    {
        if ($submit eq '')
        {
            #code
        }
        elsif ($submit eq 'Submit Form')
        {
            if ( !$filename )
            {
                print $query->header ( );
                print "There was a problem uploading your photo (try a
+ smaller file).\n";
                $abtflg = $TRUE;
                print "\$abtflg = [$abtflg]\n";
                last;
            }

            my ( $name, $path, $extension ) = fileparse ( $filename, '
+..*' );
            print "\$name = [$name]\n";
            print "\$path = [$path]\n";
            print "\$extension = [$extension]\n";
            $filename = $name . $extension;
            print "\$filename = [$filename]\n";
            $filename =~ tr/ /_/;
            print "\$filename = [$filename]\n";
            $filename =~ s/[^$safe_filename_characters]//g;
            print "\$filename = [$filename]\n";
            if ( $filename =~ /^([$safe_filename_characters]+)$/ )
            {
                $filename = $1;
                print "\$filename = [$filename]\n";
            }
            else
            {
                print "ERROR:  Filename contains invalid characters\n"
+;
            }

            my $upload_filehandle = $query->upload("photo");
            print "\$upload_filehandle = [$upload_filehandle]\n";
            my $output_filename = "$upload_dir/$filename";
            print "\$output_filename = [$output_filename]\n";
            my $open_ret = open ( UPLOADFILE, ">" ) or print "$!\n";
            print "\$open_ret = [$open_ret]\n";
            if (!$open_ret)
            {
                print "Error opening output file \"$output_filename\"\
+n";
                $abtflg = $TRUE;
                print "\$abtflg = [$abtflg]\n";
                last;
            }
            binmode UPLOADFILE;
            print "Preparing to read and write\n";
            while ( my $upload_data = <$upload_filehandle> )
            {
                my $upload_length = length $upload_data;
                print "\$upload_length = [$upload_length]\n";
                my $write_ret = print UPLOADFILE;
                print "\$write_ret = [$write_ret]\n";
            }
            print "Preparing to close UPLOADFILE\n";
            close UPLOADFILE;
            print "Done.\n";
        }
    }
}

#if ($@)
#{
#    # Capture error message
#    my $errmsg = $@;
#
#    # !Convert to HTML
#    #$errmsg =~ s/\n/\<br \/\>\n/g;
#
#    print "Eval Error:  $errmsg\n";
#}

&footer();

exit;

{
    # Persistent local variables
    my $hdrflg;

    # Actual routine
    sub header
    {
        if (!defined $hdrflg)
        {
            print "Content-Type: text/html\n\n";
            print "<!DOCTYPE html>\n";
            print "<html>\n";
            print "  <head>\n";
            print "    <title>My CGI File Upload Test</title>\n";
            print "  </head>\n";
            print "  <body>\n";
            print "    <p><pre>\n";
        }
        $hdrflg = $TRUE;
    }

    sub footer
    {
        {
            print "    </pre></p>\n";
            print "  </body>\n";
            print "</html>\n";
        }
        $hdrflg = $TRUE;
    }
}


__END__

# http://www.bhmk.com/pmcgitest/photup.htm
[download]

Results:

###############################################
# CGI IN
$query = [CGI=HASH(0xb72b4ec)]
$submit = [Submit Form]
$user_id = [marinersk]
$filename = [Humor-Fake-Doctor-001a.bmp]
$safe_filename_characters = [a-zA-Z0-9_.-]
$upload_dir = [.]
$CGI::POST_MAX = [5120000]
###############################################
####################################################
##################### Main Page ####################
####################################################
$abtflg = [0]
$name = []
$path = [./]
$extension = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$filename = [Humor-Fake-Doctor-001a.bmp]
$upload_filehandle = [Humor-Fake-Doctor-001a.bmp]
$output_filename = [./Humor-Fake-Doctor-001a.bmp]
No such file or directory
$open_ret = []
Error opening output file "./Humor-Fake-Doctor-001a.bmp"
$abtflg = [1]
[download]

So I'll play with it a bit on my end, but could you use this as the basis for your work for a bit so we can isolate the problem?

Update: Added the updated HTML file as well

Comment on Re: File Upload On Windows 8 and Perl Select or Download Code

Replies are listed 'Best First'.
Re^2: File Upload On Windows 8 and Perl by marinersk (Priest) on Jul 04, 2015 at 20:35 UTC
Oops. Left out the filename for the `open`after extracting it to its own scalar for debugging purposes. Now mine is sitting and spinning; it may be uploading the file, hard to tell. `my $open_ret = open ( UPLOADFILE, ">" ) or print "$!\n"; my $open_ret = open ( UPLOADFILE, ">", $output_filename ) or print "$! +\n";` [download]	[reply] [d/l] [select]
Re^2: File Upload On Windows 8 and Perl by marinersk (Priest) on Jul 04, 2015 at 20:59 UTC
Okay, mine timed out now. I'm going to rip everything out and start over from the template, avoiding all the added features you've tossed in (usernames and crypt keys and unreferenced DBI modules, oh my!). I try not to be a `NIH`^* guy, but sometimes you just gotta' rebuild the wheel to see how it keeps the chandelier floating at the Shindig. ^Not Invented Here*	[reply] [d/l]