Why is this upload script not working

M

Mark Constant

I looked at a couple of scripts on how to upload a file and came up
with the script below. Now the script acts like it uploaded the file
by not giving errors but when I check the directory no file is there.
The script runs from /cgi-bin/ and the quickbooks directory is chmod
755. What I am trying to do is upload a quickbooks file that is 50mbs.
Here are the most important parts. I only left out how I got the time
and date.

#!/usr/bin/perl
use CGI;
$q = new CGI;
$file = $q->param("upfile");
$dir = "../htdocs/quickbooks";
$filename = "$file-$date-$time";

print $q->header, $q->start_html("Uploading File");
print $q->h1("Upload Results");

if(!file){
print "Nothing Uploaded\n";
} else {
print "Filename: $filename<br />\n";
$ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, ">$dir/$filename") or dienice("Can't upload file: $!
\n");
binmode(OUTFILE);
while (my $bytesread = read($file, $buffer, 1024)) {
print OUTFILE $buffer;
}
close(OUTFILE);
print "File saved\n";
}

$q->end_html;

sub dienice {
my($msg) = @_;
print "<h2>Error</h2>\n";
print $msg;
exit;

}
 
B

Ben Morrow

Quoth (e-mail address removed) (Mark Constant):
I looked at a couple of scripts on how to upload a file and came up
with the script below. Now the script acts like it uploaded the file
by not giving errors but when I check the directory no file is there.
The script runs from /cgi-bin/ and the quickbooks directory is chmod
755. What I am trying to do is upload a quickbooks file that is 50mbs.
Here are the most important parts. I only left out how I got the time
and date.

#!/usr/bin/perl
use CGI;
$q = new CGI;
$file = $q->param("upfile");
$dir = "../htdocs/quickbooks";
$filename = "$file-$date-$time";

print $q->header, $q->start_html("Uploading File");
print $q->h1("Upload Results");

if(!file){
print "Nothing Uploaded\n";
} else {
print "Filename: $filename<br />\n";
$ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, ">$dir/$filename") or dienice("Can't upload file: $!
\n");

Does this open succeed? If the directory you are copying to has 755
permissions I would be slightly surprised: I would have expected that
Apache would run as a different user requiring you to give 777
permissions.
binmode(OUTFILE);
while (my $bytesread = read($file, $buffer, 1024)) {
print OUTFILE $buffer;
}

You can do this more easily with

local $/ = \1024;
print OUTFILE $_ while <$file>;

I would also check each read, as you're reading from a socket:

local $/ = \1024;
undef $!;

while (<$file>) {
print OUTFILE $_;
}
continue {
undef $!;
}
$! and dienice "read failed: $!";
close(OUTFILE);

Just to be sure, check for errors:

close OUTFILE or dienice "can't close $filename: $!";

Ben
 
T

Tore Aursand

#!/usr/bin/perl

#!/usr/bin/perl -T
use strict;
use warnings;
$q = new CGI;
$file = $q->param("upfile");
$dir = "../htdocs/quickbooks";
$filename = "$file-$date-$time";

my $q = CGI->new();
my $file = $q->param( 'upfile' ); # Stick with one OO "style"
my $dir = '../htdocs/quickbooks'; # No need for double quotes
print $q->header, $q->start_html("Uploading File");
print $q->h1("Upload Results");

Useless use of double quotes (twice).
if(!file){

Sure you mean 'file' and not '$file'? And why not keep it a bit more
English and write 'unless ( $file )' instead...?

As for why the upload seems to work, but there's not file created, I
really don't know. Are you _sure_ that your 'dienice' routine traps
everything it should?

What happens when you turn on taint mode (ie. '-T')?
 
M

Mark Constant

Well I listened to some of the suggestions and it still doesn't work.
I tried Ben's way but it still acts like it is uploading the file and
never does. Here is what I have now. Now I am at work and don't have
linux so I had to change the way the slashes. Also Taint mode doesn't
really work because it says it is too late for Taint mode (Guess it is
because I am running in this in Windows). I noticed that when the HTML
displays it says that my destination is ..\htdocs\quickbooks$file. I
want it to be ..\htdocs\quickbooks\$file where $file of course is
replaced with the actually file name. Also should I be stripping the
forward slashes out of the file name?

#!c:\perl\bin\perl -T
use strict;
use warnings;
use CGI;

my $q = CGI->new();
my $file = $q->param('upfile');
my $dir = '..\htdocs\quickbooks';
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$file){
print "Nothing Uploaded\n";
} else {
print "Filename: $file<br />\n";
print "Destination: $dir\$file<br />\n";
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, ">$dir\$file") or dienice("Can't upload file: $! \n");
binmode(OUTFILE);

while (my $bytesread = read($file, my $buffer, 1024)) {
print OUTFILE $buffer;
}

close(OUTFILE);
print "File saved\n";
}

$q->end_html;

sub dienice {
my($msg) = @_;
print "<h2>Error</h2>\n";
print $msg;
exit;

}
 
B

Ben Morrow

Quoth (e-mail address removed) (Mark Constant):
Well I listened to some of the suggestions and it still doesn't work.
I tried Ben's way but it still acts like it is uploading the file and
never does. Here is what I have now. Now I am at work and don't have
linux so I had to change the way the slashes.

No you don't. Real slashes work just as well on Win32.
Also Taint mode doesn't
really work because it says it is too late for Taint mode (Guess it is
because I am running in this in Windows).

No, it's because it's too late... I would create an association from
..plt to 'perl -T "%1"' (or whatever the syntax is) in addition to the
one from .pl to 'perl "%1"'; then you can make scripts taint by changing
the extn. Leave the -T on the #! line: that way you'll get an error if
it should run without tainting by accident.
I noticed that when the HTML
displays it says that my destination is ..\htdocs\quickbooks$file. I
want it to be ..\htdocs\quickbooks\$file where $file of course is
replaced with the actually file name. Also should I be stripping the
forward slashes out of the file name?

Yes. You should (in fact must, under taint mode) check that the name is
what you expect. Read perldoc perlsec. Something like

$file =~ /^([\w.-]+)$/ or dienice "Invalid filename: $file";
my $filename = $1;

is safe; you may want to restrict the name more or less depending on
your circumstances. You *definitely* don't want to allow anything
windows treats as 'special': at least / \ :, there may be more. Note
that I assign the untainted name to a new variable, as $file is special
(it's a FH as well as a string) and mustn't be replaced.
#!c:\perl\bin\perl -T
use strict;
use warnings;
use CGI;

my $q = CGI->new();
my $file = $q->param('upfile');
my $dir = '..\htdocs\quickbooks';
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$file){
print "Nothing Uploaded\n";
} else {
print "Filename: $file<br />\n";
print "Destination: $dir\$file<br />\n";

You are double-quoting, so "\$" simply produces a literal '$'. Try

print "Destination: $dir\\$file<br/>\n";

or, better,

print "Destination: $dir/$file<br/>\n";

or, better still,

use File::Spec::Functions qw/catfile splitdir/;
my $path = catfile splitdir($dir), $file;
print "Destination: $path said:
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, ">$dir\$file") or dienice("Can't upload file: $! \n");

The same applies here. It is also better to use 3-arg open, and lexical
FHs:

open my $OUT, '>', $path or dienice ...;

or even

open my $OUT, '>:raw', $path or dienice...;

which alleviates the need for 'binmode'.
binmode(OUTFILE);

You should probably also investigate CGI::Carp, which can make sure that
*all* errors end up properly reported.

Ben
 
R

Richard Morse

I looked at a couple of scripts on how to upload a file and came up
with the script below. Now the script acts like it uploaded the file
by not giving errors but when I check the directory no file is there.
The script runs from /cgi-bin/ and the quickbooks directory is chmod
755. What I am trying to do is upload a quickbooks file that is 50mbs.
Here are the most important parts. I only left out how I got the time
and date.

#!/usr/bin/perl
use CGI;
$q = new CGI;
$file = $q->param("upfile"); [snip]
sub dienice {
my($msg) = @_;
print "<h2>Error</h2>\n";
print $msg;
exit;

}

While you're figuring out how to make this work properly, I would
suggest using CGI::Carp to get the errors -- something like:

#!/usr/bin/perl
use strict;
use warnings;

use CGI;
use CGI::Carp qw/fatalsToBrowser/;

my $q = new CGI;
#blah blah blah
die("didn't work because of $!"); # will send errors to the browser...

HTH,
Ricky
 
M

Mark Constant

Well I added some more changes and the error I get from Carp is below.
I don't see how this error can be. I chmod my quickbooks directory to
777. The directory structure is basic.
/var/www/htdocs
/var/www/htdocs/quickbooks
/var/www/cgi-bin/uploader.cgi

Upload Results
Filename: loadlin16c.zip
Destination: ../htdocs/quickbooks/loadlin16c.zip
MIME Type: application/x-zip
Content-type: text/html

Software error:
Didn't work because of File Permission

For help, please send mail to the webmaster

Here is my updated code again
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use warnings;
my $q = CGI->new();

my $file = $q->param('upfile');
$file =~ /^([w.-]+)$/;
my $dir = '../htdocs/quickbooks';
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$file){
print "Nothing Uploaded\n";
} else {
print "Filename: $file<br />\n";
print "Destination: $dir/$file<br />\n";
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, '>$dir/$filename') or die("Didn't work because of $!
\n");
binmode(OUTFILE);
while (my $bytesread = read($file, my $buffer, 1024)) {
print OUTFILE $buffer;
}
close(OUTFILE);
print "File saved\n";
}

$q->end_html;

sub die {
my($msg) = @_;
print "<h2>Error</h2>\n";
print $msg;
exit;

}
 
E

Eric Bohlman

(e-mail address removed) (Mark Constant) wrote in
Here is my updated code again
use CGI;
use CGI::Carp qw/fatalsToBrowser/;

You throw away the benefits of using this by defining your own die() sub
later on. CGI::Carp redefines Perl's built-in die() to properly output to
the browser, but you're using your own die() which, among other things,
won't be able to report compile-time errors.
use strict;
use warnings;

For reasons that will become clear later, add 'use Cwd;' here.
my $q = CGI->new();

my $file = $q->param('upfile');
$file =~ /^([w.-]+)$/;

This is worse than useless. It silently bypasses taint-checking while
still allowing dangerous filenames through. At the very least, change it
to

$file =~ /^([w.-]+)$/ or die "Unacceptable file name: $file";

though in production you'd want to do something more user-friendly.
my $dir = '../htdocs/quickbooks';

In a CGI context, relative pathnames are a red flag unless you've done an
explicit chdir(). Your cwd often isn't what you think it is when you're
running as a CGI process. And when it is what you think it is, it's often
so only by coincidence. Code that relies on relative paths without a
chdir() has a nasty habit of breaking if moved to another server, or if the
current server is reconfigured.
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$file){
print "Nothing Uploaded\n";
} else {
print "Filename: $file<br />\n";
print "Destination: $dir/$file<br />\n";

print 'cwd is: ',cwd,"<br />\n";

This will tell you what your cwd is. Please do *not* respond to this post
until *after* you've tried this. There's no point in people trying to
guess whether or not you're in the right directory when you can have perl
*tell* you.
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, '>$dir/$filename') or die("Didn't work because of $!
\n");

$filename is neither declared nor used in any of your code. Since you have
strict turned on, either your code failed to compile, with the error
message being lost because you overrode die(), or your actual code uses
$file, in which case you're wasting everybody's time by posting mutant
code.
binmode(OUTFILE);
while (my $bytesread = read($file, my $buffer, 1024)) {
print OUTFILE $buffer;
}
close(OUTFILE);
print "File saved\n";
}

$q->end_html;

sub die {
my($msg) = @_;
print "<h2>Error</h2>\n";
print $msg;
exit;

}

Once again, you shouldn't do this.

If your problem really is a permissions error, it's likely to be because
your cwd isn't what you think it is.
 
G

Gunnar Hjalmarsson

Eric said:
Mark said:
my $file = $q->param('upfile');
$file =~ /^([w.-]+)$/;

This is worse than useless. It silently bypasses taint-checking
while still allowing dangerous filenames through. At the very
least, change it to

$file =~ /^([w.-]+)$/ or die "Unacceptable file name: $file";

Suppose you mean \w

But besides that, $file does still not get untainted, so that's not
very useful either.

if ($file =~ /^([\w.-]+)$/) {
$file = $1;
} else {
die "Unacceptable file name: $file";
}
 
B

Ben Morrow

Quoth Gunnar Hjalmarsson said:
Eric said:
Mark said:
my $file = $q->param('upfile');
$file =~ /^([w.-]+)$/;

This is worse than useless. It silently bypasses taint-checking
while still allowing dangerous filenames through. At the very
least, change it to

$file =~ /^([w.-]+)$/ or die "Unacceptable file name: $file";

Suppose you mean \w

But besides that, $file does still not get untainted, so that's not
very useful either.

if ($file =~ /^([\w.-]+)$/) {
$file = $1;

This is still wrong; had he actually read my last post this would have
been clear...

$file is a CGI file upload object. You need to use a different variable
for the untainted filename.

Ben
 
G

Gunnar Hjalmarsson

Ben said:
Quoth Gunnar Hjalmarsson said:
if ($file =~ /^([\w.-]+)$/) {
$file = $1;

This is still wrong; had he actually read my last post this would
have been clear...

$file is a CGI file upload object. You need to use a different
variable for the untainted filename.

Thanks for the correction. I forgot about the special nature of the
$file variable.
 
M

Mark Constant

Well I think I am getting close. A file by the name of $path ends up
in the quickbooks directory now. The file contains nothing though
which I don't understand. Please bear with me on this because I am
trying to take everybodies suggestions. Below is what outputs.
Upload Results

Filename: XF86Config.new
Destination: /var/www/htdocs/quickbooks/XF86Config.new
Original CWD was: /var/www/htdocs
New CWD after chdir is: /var/www/htdocs/quickbooks
MIME Type: text/plain
File saved

Here is my code
#!/usr/bin/perl -T
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use File::Spec::Functions qw/catfile splitdir/;
use strict;
use warnings;
use Cwd;

my $q = CGI->new();
my $file = $q->param('upfile');
$file =~ /^([\w.-]+)$/ or die "Unaccetable file name: $file";
my $filename = $1;
my $cdir = cwd;
chdir('quickbooks');
my $dir = cwd;
my $path = catfile splitdir($dir), $filename;

print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$filename){
print "Nothing Uploaded\n";
} else {
print "Filename: $filename<br />\n";
print "Destination: $path<br />\n";
print 'Original CWD was: ',$cdir,"<br />\n";
print 'New CWD after chdir is: ', $dir,"<br />\n";
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, '>$path') or die("Didn't work because of $! \n");
binmode(OUTFILE);
while (my $bytesread = read($filename, my $buffer, 1024)) {
print OUTFILE $buffer;
}
close(OUTFILE);
print "File saved\n";
}

$q->end_html;
 
B

Ben Morrow

Quoth (e-mail address removed) (Mark Constant):
Well I think I am getting close. A file by the name of $path ends up
in the quickbooks directory now. The file contains nothing though
which I don't understand. Please bear with me on this because I am
trying to take everybodies suggestions. Below is what outputs.
Upload Results

Filename: XF86Config.new
Destination: /var/www/htdocs/quickbooks/XF86Config.new
Original CWD was: /var/www/htdocs
New CWD after chdir is: /var/www/htdocs/quickbooks
MIME Type: text/plain
File saved

Here is my code
#!/usr/bin/perl -T
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use File::Spec::Functions qw/catfile splitdir/;
use strict;
use warnings;
use Cwd;

my $q = CGI->new();
my $file = $q->param('upfile');
$file =~ /^([\w.-]+)$/ or die "Unaccetable file name: $file";
my $filename = $1;
my $cdir = cwd;
chdir('quickbooks');

No. Use a full path: you can't be sure what the cwd will be.

chdir '/var/www/htdocs/quickbooks'
or die 'can't cd to quickbooks dir: $!";
my $dir = cwd;
my $path = catfile splitdir($dir), $filename;

As you are now in the right place you can just use relative paths; or
use Cwd::abs_path:

my $path = abs_path $filename;
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$filename){
print "Nothing Uploaded\n";
} else {
print "Filename: $filename<br />\n";
print "Destination: $path<br />\n";
print 'Original CWD was: ',$cdir,"<br />\n";
print 'New CWD after chdir is: ', $dir,"<br />\n";
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, '>$path') or die("Didn't work because of $! \n");
binmode(OUTFILE);
while (my $bytesread = read($filename, my $buffer, 1024)) {
print OUTFILE $buffer;
}

$filename is just the name. $file is the magic CGI handle.

my ($read, $buffer);
print OUTFILE $buffer
while $read = read $file, $buffer, 1024;
defined $read or die "read failed: $!";
close(OUTFILE);

close OUTFILE or die "close of uploaded file failed: $!";
close $file or die "close of socket failed: $!";
print "File saved\n";
}

$q->end_html;

Ben
 
A

Arun

You might also want to check the attributes of your form tag
they should contain the attribute ENCTYPE="multipart/form-data"
 
M

Mark Constant

Well the script finally uploads a file which is great. Only one
problem It uploads without the -T switch which means the file is not
untainted. I have looked at perlsec(1) and I am somewhat still curious
as to why this is not getting untainted. Also I have one other
question. Is there a way to let the user now how long the upload will
take. I am going to have them upload 50 meg files so I will like the
uploader.cgi to give an approximate time of how long it will take.
Thanks.

#!/usr/bin/perl -T
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use warnings;
use Cwd;
use Cwd 'abs_path';
my $q = CGI->new();
my $file = $q->param('upfile');
$file =~ /^([\w.-]+)$/ or die "Unaccetable file name: $file";
my $filename = $1;
my $cdir = cwd;
chdir('/var/www/htdocs/quickbooks/') or die "Can't cd to quickbooks
dir: $!";
my $dir = cwd;
my $path = abs_path $file;
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');

if(!$file){
print "Nothing Uploaded\n";
} else {
print "Filename: $file<br />\n";
print "Destination: $path<br />\n";
print "Original CWD was: $cdir<br />\n";
print "New CWD after chdir is: $dir<br />\n";
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, ">$path") or die("Didn't work because of $! \n");
binmode(OUTFILE);
my ($read, $buffer);
print OUTFILE $buffer
while $read = read $file, $buffer, 1024;
defined $read or die "read failed: $!";
close OUTFILE or die "Close of uploaded file failed: $!";
close $file or die "Close of socked failed $!";
print "File saved\n";
}

$q->end_html;
 
K

krakle

I looked at a couple of scripts on how to upload a file and came up
with the script below. Now the script acts like it uploaded the file
by not giving errors but when I check the directory no file is there.
The script runs from /cgi-bin/ and the quickbooks directory is chmod
755.
What I am trying to do is upload a quickbooks file that is 50mbs.

Perhaps the server has set a limit. By the way this isn't a Perl
question.

Here are the most important parts. I only left out how I got the time
and date.

#!/usr/bin/perl

Wheres the -Tw switches?


Where's the use of the strict pragma?
$q = new CGI;
$file = $q->param("upfile");
$dir = "../htdocs/quickbooks";
$filename = "$file-$date-$time";

No scoping of variables?
print $q->header, $q->start_html("Uploading File");
print $q->h1("Upload Results");

if(!file){

file? $file?

blah blah blah. I hope you didn't goto cgi-101.... Pick up a Perl book
off the shelf.
 
A

Arun

You might want to check the form tag of your html file , it should
have an attribute defined as ENCTYPE="multipart/form-data"
 
R

Richard Morse

open(OUTFILE, '>$dir/$filename')

So a lot of people here complain if you use '"' (ie, double-quotes)
where you don't need to. However, this is one place where you should.
What this line is creating is a file named dollar-sign, f, i, l, e, n,
a, m, e (that is, exactly those characters) in a directory named
dollar-sign, d, i, r. You probably want this to read:

open(OUTFILE, '>', "$dir/$filename") ...

I would actually suggest using a lexical file handle, such as:

open my $out, '>', "$dir/$filename") ...

but that's your call.

Ricky
 
B

Ben Morrow

Quoth Richard Morse said:
So a lot of people here complain if you use '"' (ie, double-quotes)
where you don't need to. However, this is one place where you should.
What this line is creating is a file named dollar-sign, f, i, l, e, n,
a, m, e (that is, exactly those characters) in a directory named
dollar-sign, d, i, r. You probably want this to read:

open(OUTFILE, '>', "$dir/$filename") ...

I would actually suggest using a lexical file handle, such as:

open my $out, '>', "$dir/$filename") ...

And if this is meant to be in any way portable (certainly if it's in a
module) you shoudl use File::Spec instead.

Ben
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,764
Messages
2,569,564
Members
45,041
Latest member
RomeoFarnh

Latest Threads

Top