There are a number of changes/recommendation's I'd make here.
- Always, always, always run under use strict
and use warnings.
- Use the CGI module's function for printing the HTML header, rather
than writing it yourself.
- Define all your files & file paths right up front, rather than
having them scattered through the file. I haven't done it here, but
you might even consider making them constants.
- Simplify your regexp, and make sure it does what you mean; anchor
it to the end of the string, so it won't match my_file.jpeg.txt.
- Use a better system for tracking the file number. The subroutine
I've used here is taken from the
Perl Cookbook, and uses
file locking to prevent two programs (or the same program) from
writing to the file at the same time. This is an important
consideration anytime you're doing file I/O from the web.
- The CGI.pm docs recommend using $cgi->upload for
upload fields.
So, finally, here's my code:
#!/usr/bin/perl
use strict ;
use warnings ;
use CGI ;
use CGI::Carp qw( fatalsToBrowser ) ;
use Fcntl qw( :DEFAULT :flock ) ;
my $cgi = new CGI ;
print $cgi->header ;
my $dir = "/www/test" ;
my $count = "/www/test/counter.dat" ;
my $file = $cgi->param( 'file' ) ;
if ( $file =~ /.(jpe?g|gif)$/i )
{
accept_file( $file, $dir, next_file_number( $count ), $1 ) ;
}
else
{
print <<"END_OF_MSG" ;
<h1>$file</h1>
Sorry, but you have either not selected a file to upload or you are
trying to upload an invalid picture file. Only the following file
extensions are supported: /.jpeg/.gif/.jpg. Please press the 'back'
button below to return to the Upload form.
END_OF_MSG
}
sub accept_file
{
my ( $file, $path, $file_num, $ext ) = @_ ;
open FH, ">$path/$file_num.$ext"
or die "Can't open $path/$file_num.$ext: $!" ;
binmode FH ;
while ( <$file> )
{
print FH $_;
}
close FH ;
}
sub next_file_number
{
my $counter_file = shift ;
sysopen FH, $counter_file, O_RDWR|O_CREAT
or die "Can't open $counter_file: $!" ;
flock( FH, LOCK_EX ) or die "Can't write-lock $counter_file: $!
+" ;
# Now we have acquired the lock, it's safe for I/O
my $num = <FH> || 0 ;
seek FH, 0, 0 or die "Can't rewind $counter_file: $!" ;
truncate FH, 0 or die "Can't truncate $counter_file: $!"
+;
print FH ++$num, "\n" or die "Can't write $counter_file: $!" ;
close FH or die "Can't close $counter_file: $!" ;
return $num ;
}
_______________
DamnDirtyApe
Those who know that they are profound strive for clarity. Those who
would like to seem profound to the crowd strive for obscurity.
--Friedrich Nietzsche
| [reply]
[d/l]
[select] |
Thank's for your reply, will give it a go
Pip
| [reply] |
One other comment in addition to DamnDirtyApe's excellent post - you should set the POST_MAX to a reasonable number. Otherwise someone could upload a 20GB file filling your drive, effectively creating a DOS attack.
$CGI::POST_MAX = 1024 * 1000 # 1MB
You mentioned you are new to programming Perl, so for dealing with CGI applications I would highly recommend using Ovid's CGI::Safe module to help catch some security issues you may miss.
grep
|
Just me, the boy and these two monks, no questions asked. |
| [reply]
[d/l] |
Thanks for pointing this out, grep
Rainer
| [reply] |
You might also want to take a look at the MIME type of the file upload, as well as the file extension using:
$type = $query->uploadInfo($filename)->{'Content-Type'};
Some OSs (pre-X Mac OS for example) rarely use file extensions to signify file types - so it's worth checking if you want to support those users.
My usual method is to believe the file extension if it's there, then back down to the Content-Type, then give up.
| [reply]
[d/l] |
Thanks for your reply
Rainer
| [reply] |
Here this upload script might suit your purpose. I'll leave it up
to you to add the filtering for gif, and jpgs. It should be obvious
where it goes.
#!/usr/bin/perl -wT
use strict;
use CGI;
my $q = new CGI;
#The max size of the uploaded file:
$CGI::POST_MAX = 1024 * 1024 * 30;
my $maxfile = $CGI::POST_MAX;
#The folder with the uploaded files:
my $outfolder = "uploads";
&upload;
#######################################################
sub upload {
my ($filen, $ext);
#Print the start of the page:
$| = 1;
print <<eof;
Content-type: text/html
Uploading the file...
<body><html>
eof
my $file = $q->upload('file');
my $filename = $file;
$filename =~ s/^.*\///g;
$filename =~ s/^.*\\//g;
$filename =~ s/\-/_/g;
$filename =~ s/^\.*//g;
$filename =~ s/ /_/g;
my $allpath = $file;
if ($filename =~ /\./) {
$filen = $`;
$ext = $';
}
my $maxtries=4;
for (my $i=1; $i < $maxtries; $i++) {
if (-e "$outfolder/$filename") {
$filename = $filen . "_" . $i . '.' . $ext;
}
}
#Create the file on the server, and print the "." on the page:
open(OUT, ">$outfolder/$filename")
or die "Can't open $outfolder/$file for writing. - $!";
binmode OUT;
while(read($file, my $buffer, 4096)){;
print OUT $buffer;
}
close OUT;
my $filesize = -s "$outfolder/$filename";
$filesize = (int(($filesize / 1024) * 10) / 10);
$filesize = "$filesize KB";
#Print on the browser:
my $script = 'http://zentara.zentara.net/~zentara/up2.html';
print <<eof;
<br><br>
The file $filename was successfully uploaded!<br>
The file has $filesize.<br>
<div class="center">
<a href="$script">Go back if you want to upload one more file.</a>
<a href="http://zentara.zentara.net/~zentara">Go to home page!</a>
</body></html>
eof
#End the subroutine
}
| [reply]
[d/l] |
Thanks for this script zentera, appreciate it will give it a go
Pip
| [reply] |
Hello Zentara,
Sorry to bother you again, script is working fine, but.....
I don't know where to put the exclusions for gif and jpg files, and don't know how to get the message back in there to notify user if they have entered the wrong file format.
Appreciate the help very much as I'm not good at this, but willing to learn and try
pip
| [reply] |