#!/usr/bin/perl -wT use strict; use CGI; use CGI::Carp qw ( fatalsToBrowser ); use File::Basename; use File::Copy; use Fcntl qw( :DEFAULT :flock ); use IO::Handle; use constant UPLOAD_DIR => "/var/www/files/"; use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 32 * 1_048_576; use constant MAX_DIR_SIZE => 1000 * 1_048_576; use constant MAX_OPEN_TRIES => 100; sub DisplayForm; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; my $q = new CGI; $q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_error ); # # If we're invoked directly, display the form and get out. # if (! $q->param("file") ) { DisplayForm(); exit; } my $file = $q->param( "file" ) || error( $q, "No file received." ); my $fh = $q->upload( "file" ); my $io_handle = $fh->handle; my $buffer = ""; my ( $name, $path, $extension ) = fileparse ( $file, '\..*' ); my $filename = $name . $extension; if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) { error( $q, "Upload directory is full." ); } # Allow letters, digits, periods, underscores, dashes # Convert anything else to an underscore $filename =~ s/[^\w.-]/_/g; if ( $filename =~ /^(\w[\w.-]*)/ ) { $filename = $1; } else { error( $q, "Invalid file name; files must start with a letter or number." ); } # Just copy from temp file to destination. No need to open a file and write it. my $tmpfilename = $q->tmpFileName($file); copy $tmpfilename, UPLOAD_DIR . $filename; 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 die "Unable to open $dir: $!"; while ( readdir DIR ) { $dir_size += -s "$dir/$_"; } return $dir_size; } sub error { my( $q, $reason ) = @_; print $q->header( "text/html" ), $q->start_html( "Error" ), $q->h1( "Error" ), $q->p( "Your upload was not procesed because the following error ", "occured: " ), $q->p( $q->i( $reason ) ), $q->end_html; exit; } my $title = "Upload file - Success"; print $q->header('text/html'), $q->start_html($title), $q->h1($title), $q->a({href=>"http://saivert.com/files/".$filename},"Download"), $q->end_html; # # DisplayForm - spits out HTML to display our upload form. # sub DisplayForm { my $title = "Upload file"; print $q->header('text/html'), $q->start_html($title), $q->h1($title); print $q->start_form(-method=>"post", -action=>"file_upload.pl", -enctype=>&CGI::MULTIPART), $q->filefield(-name=>'file'), $q->br, $q->br, $q->submit, $q->end_form; print $q->end_html; }