Using the CGI Module to upload Files.

LostS has asked for the wisdom of the Perl Monks concerning the following question:

OK... I am using the CGI module for an upload script. However... I need to limit the size of the directory and the size of the file. Can you all possible help?? Here is my code however it doesn't work :(

#!/usr/bin/perl

alarm(600);
use CGI;
use Fcntl qw( :DEFAULT :flock);
use File::Basename;

use constant UPLOAD_DIR        => "/usr2/home/undernet/losts/public_ht
+ml/playeruploads/";
use constant BUFFER_SIZE    => 16_384;
use constant MAX_FILE_SIZE    => 2 * 1_048_576; # Limit each upload to
+ 10mb
use constant MAX_DIR_SIZE    => 100 * 1_048_576; # Limit total uploads
+ to 500mb
use constant MAX_OPEN_TRIES    => 100;

$CGI::DISABLE_UPLOADS    = 0;
$CGI::POST_MAX        = -1;

$in = new CGI;

$img1        = $in->param('image');
$action        = $in->param('action');
$imgdir        = '/usr2/home/undernet/losts/public_html/playeruploads'
+;

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

if ($action eq "uploadfile") {
    &uploadfile;
} else {
    &displayform;
}

&footer;



sub displayform {
    print << "!!!EOF!!!";
<h2>Please fill in the file-upload form below</h2>
<form method='POST' enctype='multipart/form-data' action='uploads.cgi'
+>
<input type="hidden" name="action" value="uploadfile">
UserName: $ENV{'REMOTE_USER'}<br>
File to upload: <input type="FILE" Name="image" size="50%"><br>
<br>
<input type=submit value=Press> to upload the file!
</form>
<HR>
<h3><font color=red><u><B>NOTE</b></u>: All Files older then 1 month o
+ld will be deleted over time.  This is so I can save Web Space.  This
+ is <u><b>NOT</b></u> an archieving site.</font></h3>
<a href=http://www.ralloszek.net/playeruploads/>Click Here to View Fil
+es</a>
!!!EOF!!!
}

sub headers {
    print "<HTML>\n";
    print "<TITLE>RallosZek.Net Members Only</TITLE>\n";
    print "<head>\n";
}

sub body {
    print "</head>\n";
    print "<BODY BGCOLOR=FDF7E7>\n";
    print "<h2><center>RallosZek.Net File Uploads</center></h2>\n";
    print "<hr>\n";
    print "<br>\n";
}

sub footer {
    print "<hr>\n";
    print "<center><i><font size=\"-1\">Powered by <a href=\"http://ww
+w.ralloszek.net/\">RallosZek.Net</a></font></i></center>\n";
    print "</body>\n";
    print "</html>\n";
}


sub uploadfile {
    if ($img1) {
        &uploadimage;
        &displayurl;
    } else {
        &displayerror;
    }
}

sub displayurl {
    print "<h2><center>Thank You</center></h2>\n";
    print "Your file has successfully been uplaoded.  Below is your UR
+L information<br><br>\n";
    if (($type eq ".bmp") or ($type eq ".jpg") or ($type eq ".gif")) {
        print "<b>Display Image HTML:</b> &lt\;img src=\"http://www.ra
+lloszek.net/playeruploads/$imgurl1\"&gt\;<br><br>\n";
    }
    print "<b>To Link People Directly to file:</b> &lt\;a href=\"http:
+//www.ralloszek.net/playeruploads/$imgurl1\"&gt\;$imgurl1&lt;/a&gt<br
+><br>\n";
}

sub uploadimage {
    $in->cgi_error and error( $in, "Error transfering file: " . $in->c
+gi_error );
    $file = $in->param('image');
    $filename = $in->param('image');
    $fh = $in->upload('image');
    $buffer = "";
    $filename =~ s/</&lt;/g;
    $filename =~ s/>/&gt;/g;        
    fileparse_set_fstype("MSWin32");
    ($base,$path,$type) = fileparse($filename,'\..*');
    $type = lc $type;
    $uploadedfile = $base . $type;
    
    if ( dir_size( UPLOAD_DIR ) + $ENV{'CONTENT_LENGTH'} > MAX_DIR_SIZ
+E ) {
        error( $in, "Upload directory is fully." );
    }

    $uploadedfile =~ s/[^\w.-]/_/g;
    if ( $uploadedfile =~ /^(\w[\w.-]*)/ ) {
        $uploadedfile = $1;
    } else {
        error( $in, "Invalid file name; files must start with a letter
+ or number." );
    }

    until ( sysopen OUTPUT, UPLOAD_DIR . $uploadedfile, O_RDWR|O_CREAT
+|O_EXCL, 0777 ) {
        $uploadedfile =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e;
        $1 >= MAX_OPEN_TRIES and error( $in, "Unable to save your file
+. File 1" );
    }

    while ( read($fh,$buffer,BUFFER_SIZE)) {
        print OUTPUT $buffer;
    }

    close OUTPUT;
    if ($type eq ".bmp") {
        ($basej,$pathj,$typej) = fileparse($uploadedfile,'\..*');
        system("/usr/X11R6/bin/convert $imgdir/$uploadedfile $imgdir/$
+basej.jpg");
        system("rm -f $imgdir/$uploadedfile");
        $imgurl1 = $basej . ".jpg";
        system("chmod 777 $imgurl/$basej.jpg");
    } else {
        $imgurl1 = $uploadedfile;
        system("chmod 777 $imgurl/$uploadedfile");
    }
    open(DAT, ">>/usr2/home/undernet/losts/files.dat");
    $time = time;
    print DAT "$uploadedfile\t$ENV{'REMOTE_USER'}\t$ENV{'REMOTE_ADDR'}
+\t$ENV{'REMOTE_HOST'}\t$time\n";
    close DAT;
}
    
sub displayerror {
    print "Error: $ENV{QUERY_STRING}\n";
}

sub dir_size {
    my $dir        = shift;
    my $dir_size    = 0;
    
    open DIR, $dir or die "Unable to open $dir: $!";
    while ( readdir DIR ) {
        $dir_size += -s "$dir/$_";
    }
    return $dir_size;
}

sub error {
    my( $in, $reason ) = @_;
    print    $in->h1( "Error" ),
        $in->p( "Your upload was not processed because the following e
+rror occured: " ),
        $in->p( $in->i( $reason ) );
    exit;
}
[download]

Comment on Using the CGI Module to upload Files. Download Code

Replies are listed 'Best First'.
Re: Using the CGI Module to upload Files. by Zaxo (Archbishop) on Jul 10, 2001 at 06:41 UTC
Just set this line to a positive number to limit POST size. `#$CGI::POST_MAX = -1; $CGI::POST_MAX = 10000000;` [download] To limit total size some form of filesystem quota is handiest. The best solution for that will depend oh your http server and OS. After Compline, Zaxo	[reply] [d/l]
Re: Re: Using the CGI Module to upload Files. by LostS (Friar) on Jul 10, 2001 at 06:47 UTC
Server Info: Perl Version: 5.00402 SERVER_SOFTWARE = Apache/1.3.12 (Unix) PHP/3.0.16 SERVER_OD = BSDI BSD/OS 4.0.1	[reply]