Uploading a file with Perl

[Supra]

I've seen this question posted before using search, however no one seemed to provide a working solution that I could tell, or the user just ended up writing "it works now for some reason."

Anyway, the problem is when I try to upload a file, it is always less than or equal to 1 byte in size. Here's the code:

# Upload the image
$file = $FORM{'image'}; # Image on user's computer
$cat = $FORM{'cat'};    # Category to upload image under
$totalBytes = 0;
    if ($file ne "") {
        $fileName = "test.jpg";
	open(OUTF,">$basePath/$cat/$fileName");
	  while ($bytesread = read($FORM{'image'}, $buffer, 1024)) {
	    $totalBytes += $bytesread;
		if ($totalBytes >= 102400) {				    close(OUTF);					    unlink "$basePath/$cat/$fileName";			    die("Image too big.");
		}
            print OUTF $buffer;
	  }
        close(OUTF);
	
        if ($totalBytes <= 1) {
	    unlink "$basePath/$cat/$fileName";
	    die("File <= 1 byte.");
        }
    }

I have no idea what the issue is, but it's driving me absolutely insane. The script doesn't even take a long time to finish when I try uploading a 10MB file. Instead it just immediately gives me the <= 1 byte error.

Any ideas? :\

 

[audiopro]

I think the problem is in your read statement.
This is my HTML.

<center>
<FORM METHOD="POST" ACTION="studiosoft.cgi" ENCTYPE="multipart/form-data">
<INPUT TYPE="file" NAME="FILEID" VALUE="" SIZE=50 MAXLENGTH=80><BR>
<INPUT TYPE="hidden" NAME="call" VALUE="actdown">
<INPUT TYPE="submit" NAME="submit" VALUE="uploadme"></FORM>

and now the handling script.

	my $query = new CGI;
	print $query->start_html(-title=>"UPLOAD PLEASE");
	my $fileID;
	unless($fileID = $query->param("FILEID")){
		&showError('No File name specified.');
	}
	my $LENF=length($fileID);
	my $file_ext=uc(substr($fileID,$LENF-4,4));
	if($file_ext ne ".PDF"){
print "No Good";
exit;
	}


	my @pathName=split(/\\/,$fileID);

	[b]my $newname=DIR\FILENAME;[/b]

	open(OPF,">$newname")|| &showError("Failed to open OPF,$!");
	my $bytesread;
	my $buffer;
	my $sum_bytes=0;
	while($bytesread=read([b]$fileID[/b],$buffer,1024)){
		print OPF "$buffer";
		$sum_bytes=$sum_bytes+1024;
		if($sum_bytes >600000){
			close OPF;
			unlink $newFile;
			&showError("File is too large.");
		}
	}
	close OPF;
	print $query->end_html;
	if(-e $newname){
&PROG_NOTE2("File Uploaded<br>Please Note<br>The File Name Has Been Changed From The Name of The Downloaded File.<br>The File Can Only Be Accessed From the View PDF Option Within The Web Site");

}else{
print "File Not Uploaded<br>";
}
exit;
}

$fileID has two functions- the file name and the handle to the file on the users machine. This example only uploads PDF files but can be used to upload any file, with a bit of tweaking. Set a value to $newname, the example above has had some code removed which creates a new filename in a seperate function.


Keith

http://www.studiosoft.co.uk

 

[KevinADC]

is $FORM{'image'} a file field in the html form?

<INPUT TYPE="file" NAME="image">

 

[Supra]

Thanks for the posts guys. I don't see the real difference between using $fileID and using $FORM{'image'} to be honest. Can you elaborate on this please? Yup, $FORM{'image'} refers to the file input type on my HTML form, exactly as you have it written. Is this wrong?

 

[Supra]

Well, much to my embarassment, I've found the issue. I forgot to include enctype="multipart/form-data" in my form. When I debug I can see the contents of the picture file.

However, I've run into another issue. Adding that line changed the way the POST data looks, so my code to read the other form values..

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);

foreach $pair (@pairs) {    
($name, $value) = split(/=/, $pair);    
   $value =~ tr/+/ /;    
   $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;    
   $value =~ s/~!/ ~!/g;
   $value =~ s/\r//g;
   $FORM{$name} = $value;
}

..is no longer working. As you can see, I don't have a lot of experience with parsing forms this way :\

 

[Kirsle]

Here's a (working) uploader script I wrote so I could upload files to my server from school without worrying about FTP.

#!/usr/bin/perl -w

use strict;
use warnings;
use CGI qw/:all/;
use CGI::Carp qw(fatalsToBrowser);

our $cgi = new CGI;

my $action = $cgi->param('action') || 'index';

print "Content-Type: text/html\n\n";

if ($action eq 'upload') {
	die "Invalid Password!" unless $cgi->param('password') eq 'secret';

	# Upload the file.
	my $file = $cgi->param ("file");
	my @parts = split(/(\/|\\)/, $file);
	$file = pop(@parts);

	# Pick a random name if there was an error.
	if (length $file == 0) {
		$file = "rand" . time();
	}

	# Remove any weird symbols from the file.
	$file =~ s~(\\|/|:|\*|\?|"|<|>|\|)~_~ig;

	# Save.
	my $upload = $cgi->upload ("file");

	my $binary = '';
	while (<$upload>) {
		$binary .= $_;
	}

	open (OUT, ">./upload/$file");
	binmode OUT;
	print OUT $binary;
	close (OUT);

	print "Uploaded $file successfully.";
}
else {
	print "Upload Files<p>\n\n"
		. "<form name=\"upload\" action=\"upload.cgi\" method=\"post\" enctype=\"multipart/form-data\">\n"
		. "<input type=\"hidden\" name=\"action\" value=\"upload\">\n"
		. "Password: <input type=\"password\" size=\"20\" name=\"password\"><br>\n"
		. "File: <input type=\"file\" name=\"file\" size=\"50\"><br>\n"
		. "<input type=\"submit\" value=\"Upload!\">\n"
		. "</form>\n";
}

Hope that helps ya.

 

[Kirsle]

Actually, my comments in that code might be a bit misleading (it took me a few tries to get it to work, so the initial comments weren't updated).

Here are the code bits with misleading comments with some better comments on them:

	# Get the file name from the full path
	my $file = $cgi->param ("file");
	my @parts = split(/(\/|\\)/, $file);
	$file = pop(@parts);

	# Get the binary data from the upload form
	# ($upload will be a filehandle)
	my $upload = $cgi->upload ("file");

	# Read the filehandle into the scalar $binary
	my $binary = '';
	while (<$upload>) {
		$binary .= $_;
	}

	# Save the binary file data into $file,
	# as found up in the first block of code here
	open (OUT, ">./upload/$file");
	binmode OUT;
	print OUT $binary;
	close (OUT);

That should clear up some confusion in my code.