perlquestion
mikeirw
<p>I'm working on a simple script to allow users to upload files to a web server. Everything works fine for files of about 35 KB or so, but anything at all above that causes the script to be killed by the server. My host (pair Networks) imposes the following limits on CGI resource usage:</p>
<ul>
<li> Size of Core Files - <b>0</b> MB
<li> CPU Time Used - <b>30</b> seconds
<li> Data Size - <b>3</b> MB
<li> File Size Created - <b>1</b> MB
<li> Memory Locked - <b>1</b> MB
<li> Number of Open Files - <b>32</b>
<li> Number of Simultaneous Processes - <b>8</b>
</ul>
<p>I've benchmarked the code, and it comes nowhere near the CPU time limit, even under heavy load. So, my question is, what is causing the script to be killed if the file is over 35 KB?</p>
<p>Here's the relevant parts of the script, some of which was lifted from [isbn://1565924193|CGI Programming with Perl]:</p>
<readmore>
<code>
use strict;
use CGI;
use Fcntl qw( :DEFAULT :flock );
use File::Basename;
use constant UPLOAD_DIR => '/some/dir';
use constant TYPES => qw( .txt .jpg );
use constant BUFFER_SIZE => 16_384;
use constant MAX_FILE_SIZE => 1_048_576;
use constant MAX_DIR_SIZE => 100 * 1_048_576;
use constant MAX_OPEN_TRIES => 100;
$CGI::POST_MAX = MAX_FILE_SIZE;
sub dir_size {
my $dir = shift;
my $dir_size = 0;
# Loop through files and sum the sizes; doesn't descend down subdirs.
opendir DIR, $dir or error( $q, "Unable to open $dir: $!" );
while ( readdir DIR ) {
$dir_size += -s "$dir/$_";
}
return $dir_size;
}
{
my $q = new CGI;
my $os = $q->param('os');
my $file = $q->param('file');
my $title = $q->param('title');
my $fh = $q->upload('file');
my $buffer = '';
if ( dir_size(UPLOAD_DIR) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
error( $q, 'Upload directory is full.' );
}
elsif ( $file ne '' ) {
fileparse_set_fstype($os);
my ( $base, $path, $ext ) = fileparse( $file, qr/\..*/ );
my $num_types = scalar TYPES;
my $maybe = 0;
foreach my $type (TYPES) {
$maybe++ if $type !~ /$ext/i;
}
error( $q,
'Invalid file type. Please upload only '
. join ( ' ', TYPES )
. ' files.' )
unless $maybe < $num_types;
my $filename = $base . $ext;
$filename =~ s/[^\w.-]/_/g;
if ( $filename =~ /^(\w[\w.-]*)/ ) {
$filename = $1;
}
else {
error( $q,
'Invalid file name. Files must start with a letter or number.'
);
}
# Open output file, making sure the name is unique.
until (
sysopen OUTPUT,
UPLOAD_DIR . "/$filename",
O_RDWR | O_EXCL | O_CREAT
)
{
$filename =~ s/(\d*)($ext)$/($1||0) + 1 . $2/e;
$1 >= MAX_OPEN_TRIES and error( $q, 'Unable to save your file.' );
}
# This is necessary for non-Unix systems; does nothing on Unix.
binmode $fh;
binmode OUTPUT;
while ( read( $fh, $buffer, BUFFER_SIZE ) ) {
print OUTPUT $buffer;
}
close OUTPUT;
print $q->header, $q->start_html( -title => 'Successful Upload!', ),
$q->h1('Your file was successfully uploaded!'), $q->end_html;
}
else {
error( $q, 'You must specify a file to upload.' );
}
}
</code>
</readmore>
<p><small>20020930 - Edit by [Corion]: Added READMORE tag, as it's frontpaged now</small></p>