All pastes #2122967 Raw Edit

Stuff

public text v1 · immutable
#2122967 ·published 2012-02-29 18:55 UTC
rendered paste body
#!/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;
}