comment on

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:

Size of Core Files - 0 MB
CPU Time Used - 30 seconds
Data Size - 3 MB
File Size Created - 1 MB
Memory Locked - 1 MB
Number of Open Files - 32
Number of Simultaneous Processes - 8

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?

Here's the relevant parts of the script, some of which was lifted from CGI Programming with Perl:

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 subdi
+rs.
    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 f
+ile.' );
        }

        # 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.' );
    }
}
[download]

20020930 - Edit by Corion: Added READMORE tag, as it's frontpaged now

In reply to Beating the system by mikeirw

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


There's more than one way to do things
	PerlMonks