Why is this upload script not working

[Tintin]

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") ...

But of course if error checking was specified, it would have been obvious.

open OUTFILE, ">$dir/$filename" or die "Can not open $dir/$filename $!\n";

 

[Mark Constant]

Well on Unix my script now works without the -T switch on. The error
says that the file is still tainted. On a Windows Apache Server it
complains about Unaccetable file name and doesn't even upload. I guess
there is still something wrong with the way I am stripping the path
off of the filename.


#!c:/perl/bin/perl
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('c:/progra~1/apache~1/apache2/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;

 

[Paul Lalli]

On a Windows Apache Server it
complains about Unaccetable file name and doesn't even upload.

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

Is this where your script is dieing? If so, what is the actual output?
That is, what is the contents of the $file variable when printed here?
That should give some clue on how to proceed (for example, perhaps your
regexp needs modification?)

Paul Lalli

 

[Ben Morrow]

Quoth (e-mail address removed) (Mark Constant):

Well on Unix my script now works without the -T switch on. The error
says that the file is still tainted.

What does the error say *exactly*?

On a Windows Apache Server it
complains about Unaccetable file name and doesn't even upload. I guess
there is still something wrong with the way I am stripping the path
off of the filename.

Well, you aren't stripping it off at all...

#!c:/perl/bin/perl
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use warnings;
use Cwd;
use Cwd 'abs_path';

You can reduce these to

use Cwd qw/cwd abs_path/;

or, if you must,

use Cwd qw/EFAULT abs_path/;

(this is documented in perldoc Exporter).

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

If your windows server is returning the file with a full path, or
something, then this will fail. You could try something like:

$file =~ /([\w.-]+)$/ or die "Unacceptable file name: $file";
# ^^ no '^'
my $filename = $1 or die "Unacceptable file name: $file";

This way, if a filename of 'a:\path\to\file' is provided, the
unacceptable bits will be stripped off rather than causing the script to
fail.

my $cdir = cwd;
chdir('c:/progra~1/apache~1/apache2/htdocs/quickbooks/') or die "Can't
cd to quickbooks dir: $!";

I would strongly recommend using the 'real' directory names here: those
~1 names are not completely reliable (or rather, the means by which they
are generated is not well defined, so you may find they stop pointing
where you think they do).

I would also recommend *not* using directory names with spaces in, but
that's up to you .

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");

Say what didn't work, and let Perl say where it didn't:

.... or die "Can't create $path: $!";

(note the *lack* of "\n").

binmode(OUTFILE);

Should you not binmode $file as well? (I don't know if CGI.pm does it
for you or not...)

Ben

 

[Gunnar Hjalmarsson]

Well on Unix my script now works without the -T switch on. The
error says that the file is still tainted. On a Windows Apache
Server it complains about Unaccetable file name and doesn't even
upload.

This simple upload script:

http://groups.google.com/[email protected]

works fine on Windows, and can be run with tainting enabled. Since it
makes use of the upload() function instead of param() to grab the
filehandle, it may also be more robust.

 

[Mark Constant]

This simple upload script:

http://groups.google.com/[email protected]

works fine on Windows, and can be run with tainting enabled. Since it
makes use of the upload() function instead of param() to grab the
filehandle, it may also be more robust.

I used the script and it uploads the file but I don't want to give the
file the name of the starttime. I want it to be the original filename.
How would I do that?
#!c:/perl/bin/perl
use strict;
use warnings;
use CGI;
my $dir = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks';
my $starttime = time;
my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~ /filename="([\w\-\.
]+)"/;
my $name = ($1 or $starttime);
open FILE, "> $dir/$name" or die $!;
binmode FILE;
print FILE $_ while <$fh>;
close FILE;

print "Content-type: text/html\n\n";
print "$name was uploaded.<br>";
print "It took ", time - $starttime,

Also on my other script I get this error exactly.
Cannot chdir to C:\Documents and Settings\Mark\Desktop\Trifold
Slide&Ride.doc:No such file or directory at C:/Program Files/Apache
Group/Apache2/htdocs/uploader.cgi line 22. Now I don't know why it
isn't talking about chdir when I only do that once through the whole
script. I feel like this script is close to finished but one or two
tiny things are wrong. If anybody has apache on Windows could they
test this code out. Thanks.

Now if go to line 22 in notepad it is this my $path = abs_path $file;

here is my script again
#!c:/perl/bin/perl
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use warnings;
use Cwd qw/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('C:/Program Files/Apache Group/Apache2/htdocs/quickbooks') or
die "Can't cd to quickbooks dir: $!";
my $dir = cwd;
my $path = abs_path $file;
my $notes = $q->param('notes');

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 "Can't create path $!";
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;

 

[Ben Morrow]

Quoth (e-mail address removed) (Mark Constant):

I used the script and it uploads the file but I don't want to give the
file the name of the starttime. I want it to be the original filename.
How would I do that?

Read the docs for upload and param. Upload returns a filehandle, param
returns the browser-specified name.

#!c:/perl/bin/perl
use strict;
use warnings;
use CGI;

use CGI::Carp qw/fatalsToBrowser/;
use File::Spec::Functions qw/rel2abs/;
use File::Copy;

Some whitespace wouldn't hurt.

my $dir = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks';

You're still using ~1 names...

my $starttime = time;
my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~ /filename="([\w\-\.
]+)"/;
my $name = ($1 or $starttime);

my $q = CGI->new;

my $UPLOAD = $q->upload('upfile');
my $upload = $q->param('upfile');
$upload =~ /([-\w.]+)$/ or die "unacceptable name: $upload";

open FILE, "> $dir/$name" or die $!;
binmode FILE;
print FILE $_ while <$fh>;
close FILE;

my $name = rel2abs $1, $dir;
copy $UPLOAD, $name
or die qq/can't copy upload to "$name": $!/;

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

Since you're using CGI.pm, use its header method.

print "$name was uploaded.<br>";

print qq/"$upload" was uploaded to "$name".<br>/;

or, better, use CGI's p method, which will escape the " for you.

print "It took ", time - $starttime,

Also on my other script I get this error exactly.
Cannot chdir to C:\Documents and Settings\Mark\Desktop\Trifold
Slide&Ride.doc:No such file or directory at C:/Program Files/Apache
Group/Apache2/htdocs/uploader.cgi line 22. Now I don't know why it
isn't talking about chdir when I only do that once through the whole
script. I feel like this script is close to finished but one or two
tiny things are wrong. If anybody has apache on Windows could they
test this code out. Thanks.

Now if go to line 22 in notepad it is this my $path = abs_path $file;

Cwd::abs_path (and Cwd::cwd) call chdir.

Ben

 

[Gunnar Hjalmarsson]

I used the script and it uploads the file but I don't want to give
the file the name of the starttime.

If the file was named with the start time, your browser probably grabs
the full path. (Btw, that may be the reason why your other script
failed on Windows.)

I want it to be the original filename. How would I do that?

By modifying the regex. You could for instance replace

$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename="([\w\-\. ]+)"/;
my $name = ($1 or $starttime);

with

$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename=".*?([-\w. ]+)"/;
----------------^^^
my $name = $1 or die "Couldn't grab filename $!";

Also: Replace

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

with

print $q->header;

 

[Gunnar Hjalmarsson]

Quoth (e-mail address removed) (Mark Constant):

my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename="([\w\-\. ]+)"/;
my $name = ($1 or $starttime);

my $UPLOAD = $q->upload('upfile');
my $upload = $q->param('upfile');

It didn't occur to me that you can use both the upload() and param()
function in the same upload routine. (That's why I had grabbed the
name through uploadInfo(). Think the docs could be clearer...)

Anyway I tried it, and it seems to work.

 

[Mark Constant]

Quoth (e-mail address removed) (Mark Constant):

my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename="([\w\-\. ]+)"/;
my $name = ($1 or $starttime);

my $UPLOAD = $q->upload('upfile');
my $upload = $q->param('upfile');

It didn't occur to me that you can use both the upload() and param()
function in the same upload routine. (That's why I had grabbed the
name through uploadInfo(). Think the docs could be clearer...)

Anyway I tried it, and it seems to work.

Thank you to everybody that helped. Especially Gunnar and Ben Morrow.
I just wanted to know since each time they are uploading the same
quickbooks file with the same name how can I append the date and time
to the file. I have tried the join function and when I just print
filename the name comes out as 6/4/200411:10:17Ride.doc which is what
I want but when I replace $name in the open line with $filename it
says "Use of uninitialized value in concatenation (.) or string at".
#!c:/perl/bin/perl
use strict;
use warnings;
use CGI;
my $username= $ENV{'REMOTE_USER'};
my $database = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks/database.txt';
my $dir = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks';
my $starttime = time;
(my $sec, my $min, my $hr, my $day, my $mon, my $year, my $wday, my
$yday, my $isdst) = localtime(time);
my $fixmonth = $mon + 1;
my $longyear = $year + 1900;
my $date = "$fixmonth/$day/$longyear";
my $time = "$hr:$min:$sec";
my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~ /filename=".*?([-\w.
]+)"/;
my $name = $1 or die "Couldn't grab filename $!";
my $finalname = join($time, $date, $name);
my $notes;

open OUTF, ">>$database" or die $1;
flock(OUTF, 2);
seek(OUTF, 0, 2);
print OUTF "$name | $date | $time | $notes | $username\n";
close(OUTF);

open FILE, "> $dir/$name" or die $!;
binmode FILE;
print FILE $_ while <$fh>;
close FILE;

print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');
print "$finalname was uploaded by $username.<br>";
print "It took ", time - $starttime, " seconds.\n";
print "It is now safe to go <a href='index.cgi'>back</a>.\n";
$q->end_html;

 

[Ben Morrow]

Quoth (e-mail address removed) (Mark Constant):

Thank you to everybody that helped. Especially Gunnar and Ben Morrow.
I just wanted to know since each time they are uploading the same
quickbooks file with the same name how can I append the date and time
to the file. I have tried the join function and when I just print
filename the name comes out as 6/4/200411:10:17Ride.doc which is what
I want but when I replace $name in the open line with $filename it
says "Use of uninitialized value in concatenation (.) or string at".

This is because you don't define a variable '$filename' anywhere...

#!c:/perl/bin/perl
use strict;
use warnings;
use CGI;
my $username= $ENV{'REMOTE_USER'};

This is highly unreliable: unless you know that in your case clients
will set it correctly, it is much better to have another field on the
form for the username.

my $database = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks/database.txt';
my $dir = 'c:/progra~1/apache~1/apache2/htdocs/quickbooks';

my $database = "$dir/database.txt";

, please... you're bound to forget to update one of the two when it
changes.

my $starttime = time;
(my $sec, my $min, my $hr, my $day, my $mon, my $year, my $wday, my
$yday, my $isdst) = localtime(time);
my $fixmonth = $mon + 1;
my $longyear = $year + 1900;
my $date = "$fixmonth/$day/$longyear";
my $time = "$hr:$min:$sec";

No, don't do this.

use POSIX qw/strftime/;

my $datetime = strftime "%m/%d/%Y%H:%M:%S" => localtime;

Or whatever format you actually want: your chosen format is a pretty bad
one. Firstly it contains slashes, which is Not Good for filenames;
secondly, it would be much better to have a format which sorts
correctly[1]. Something like:

my $datetime = strftime "%Y-%m-%d-%H:%M:%S" => localtime;

is pretty standard.

[1] (thirdly, the m/d/y format is so unbelievably brane-damaged I don't
know why anyone uses it...)

my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~ /filename=".*?([-\w.
]+)"/;
my $name = $1 or die "Couldn't grab filename $!";

DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.

Have you even read my last post, which shows you how to do this properly?

my $finalname = join($time, $date, $name);

Read perldoc -f join. The first argument to join is the string to join
the others together with. You can't just guess at what a function does
and expect to get it right.

my $notes;

open OUTF, ">>$database" or die $1;

'die $1'? I think not.

flock(OUTF, 2);
seek(OUTF, 0, 2);

NO NO NO. Use the constants in Fcntl.pm.

use Fcntl qw/:flock :seek/;

flock OUTF, LOCK_EX or die "can't acquire write lock on $database: $!";
seek OUTF, 0, SEEK_END or die "can't seek to the end of $database: $!";

You don't need to seek anyway as you opened the file in append mode.

Ben

 

[Gunnar Hjalmarsson]

Quoth (e-mail address removed) (Mark Constant):

[1] (thirdly, the m/d/y format is so unbelievably brane-damaged I
don't know why anyone uses it...)

Agreed.

my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename=".*?([-\w. ]+)"/;
my $name = $1 or die "Couldn't grab filename $!";

DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.

Why are you shouting? ;-) Since I'm guilty of that detail, I must say
that I don't understand the objection, Ben. If the match fails, $1
will be undef and the program will die, so what's the problem?

NO NO NO. Use the constants in Fcntl.pm.

use Fcntl qw/:flock :seek/;

flock OUTF, LOCK_EX
or die "can't acquire write lock on $database: $!";
seek OUTF, 0, SEEK_END
or die "can't seek to the end of $database: $!";

You don't need to seek anyway as you opened the file in append
mode.

Considering that, is there any need to flock?

 

[Ben Morrow]

Why are you shouting? ;-) Since I'm guilty of that detail, I must say
that I don't understand the objection, Ben. If the match fails, $1
will be undef and the program will die, so what's the problem?

No. If the match fails $1 will be whatever it happened to be set to by
the last match that succeeded. In this *particular* case, there isn't
one, so it's undef, but that is definitely a bug waiting to happen.

Considering that, is there any need to flock?

Yes. Append mode guarantees that each write(2) goes onto the end of the
file; you have no guarantee here that you might not make several
write(2)s which interleave with another process's.

Ben

 

[Gunnar Hjalmarsson]

No. If the match fails $1 will be whatever it happened to be set to
by the last match that succeeded. In this *particular* case, there
isn't one, so it's undef, but that is definitely a bug waiting to
happen.

You are right, of course. Thanks! (Damned, embarrassing mistake..)

 

[Gunnar Hjalmarsson]

Quoth (e-mail address removed) (Mark Constant):

$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename=".*?([-\w. ]+)"/;
my $name = $1 or die "Couldn't grab filename $!";

DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.

To the OP: Ben made me (finally) realize my mistake as regards that
piece of code.

Have you even read my last post, which shows you how to do this
properly?

Not saying that this is better, but a very simple fix out from the
latest script version might be:

$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename=".*?([-\w. ]+)"/ or die "Couldn't grab filename $!";
my $name = $1;

or maybe:

$q->param('upfile') =~ /([-\w. ]+)$/
or die "Couldn't grab filename $!";
my $name = $1;

With any of those changes, the script will die if the match fails even
if $1 had previously been set in some other match.

 

[John W. Krahn]

Quoth (e-mail address removed) (Mark Constant):

my $q = new CGI;
my $fh = $q->upload('upfile');
$q->uploadInfo($fh)->{'Content-Disposition'} =~
/filename=".*?([-\w. ]+)"/;
my $name = $1 or die "Couldn't grab filename $!";

DON'T USE $1 UNLESS YOU KNOW THE MATCH SUCCEEDED.

Why are you shouting? ;-) Since I'm guilty of that detail, I must say
that I don't understand the objection, Ben. If the match fails, $1
will be undef and the program will die, so what's the problem?

Or $name could be equal to '0' and the program would die as well.


John