#!/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;
}