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; }

In reply to Using the CGI Module to upload Files. by LostS

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.