Perl CGI file upload solution

elloo!

i've been playing around with perl to create a cgi file upload facility with upload monitoring
and i came up with this in hope it may help someone.

to do this, i've taken a bit of help from Randal L. Schwartz artical
"Watching long processes through CGI."

#!/usr/bin/perl -w
#
# This program is free software: you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation, either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program.  If not, see
# .
#
# PS: Randal L. Schwartz artical,
# "Watching long processes through CGI", has been modified to
# monitor CGI file upload.
#
# URL for the artical:
# http://www.stonehenge.com/merlyn/LinuxMag/col39.html
#

$|++;

use strict;
use CGI qw(:all delete_all escapeHTML);
use Fcntl qw(:DEFAULT :flock );

####################################################################
# Some constants for the program. Change it to what ever you want
# respectively.
# Example, you can change:
# 1. UPLOAD_DIR to your own defined upload directory.
# 2. BUFFER_SIZE to what ever size you want.
# 3. MAX_FILE_SIZE to what ever size you want.
#
use constant UPLOAD_DIR =>
	"/home/user/public_html/file/uploads";
use constant BUFFER_SIZE => 10;
use constant MAX_FILE_SIZE => 100 * 1_048_576;;

$CGI::DISABLE_UPLOADS = 0;
$CGI::POST_MAX = MAX_FILE_SIZE;

####################################################################
# 			ACTION HANDLER.
####################################################################
# This section is where all actions are handled.
#
if(my $progress_key = param('progress_key')) {
	print header;
	print start_html(
		-head => [""]);
	my $cache = &get_cache();
	my $progress = $cache->get($progress_key);
	unless ($progress and ref $progress eq "ARRAY") {
	    upload_form();
	    exit 0;
	}
	my $width = sprintf("%0.2f",
		(($progress->[1]/param('size')) * 100));
	print qq`

` ;
	print p(i("... continuing ...")) unless $progress->[0];

	print end_html;
}elsif(my $file = param('file')) {
	&upload_file();
}else{
	&upload_form();
}

exit 0;

####################################################################
# 		ALL SUBROTINES FOR THE PROGRAM
####################################################################
# This a subroutine which generates upload form.
#
sub upload_form (){
	print header;
	print start_html;
	print h1("Try uploading a file...");
	print qq`

		`;

	print end_html;
}

####################################################################
# This subroutine uploads the file to your server and updates the
# progressbar.
#
sub upload_file (){
	my $file = param('file');
	my $fh = upload('file');
	my $progress_key = &get_unique_id();
	my $totalsize = $ENV{CONTENT_LENGTH};
	my $cache = &get_cache();
	$cache->set($progress_key, [0, ""]);

	my $buffer = "";

	if(my $pid = fork) {
		delete_all();
		param('progress_key', $progress_key);
		param('size', $totalsize);
		print redirect(self_url());
	}elsif(defined $pid) {
		close STDOUT;
		open STDERR, ">/dev/null";
		sysopen (OUTPUT, UPLOAD_DIR .
			"/" . $progress_key . "-" . $file,
			O_CREAT | O_RDWR | O_EXCL);
		binmode $fh;
		binmode OUTPUT;
		my $bytes = 0;
		while(my $bytesread = read($fh, $buffer, BUFFER_SIZE)) {
			print OUTPUT $buffer;
			print STDERR $bytes += $bytesread . "\n";

			$cache->set($progress_key, [0, $bytes]);
		}
		$cache->set($progress_key, [1, $bytes]);

		close OUTPUT;
		exit 0;
	} else {
		die "Cannot fork: $!";
	}
}

####################################################################
# This subroutine gets an unique id.
#
sub get_unique_id (){
	return $ENV{UNIQUE_ID} if exists $ENV{UNIQUE_ID};

	require Digest::MD5;

	my $md5 = new Digest::MD5;
	my $remote = $ENV{REMOTE_ADDR} . $ENV{REMOTE_PORT};

	my $id = $md5->md5_base64(time, $$, $remote);
	$id =~ tr|+/=|-_.|;
	return $id;
}

####################################################################
# This code is taken from Randal L. Schwartz artical,
# "Watching long processes through CGI". you can find the artical at
# http://www.stonehenge.com/merlyn/LinuxMag/col39.html
#
sub get_cache() {
	require Cache::FileCache;

	  Cache::FileCache->new
	      ({
		namespace => 'upload',
		username => 'nobody',
		default_expires_in => '30 minutes',
		auto_purge_interval => '4 hours',
	       });
}
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s