#!/usr/bin/perl
#
# A quick way to use Apache+CGI with a few common
# options (Execs in ~user/public_html/cgi-bin, 
# PUT enabled) to do file upload for all the world.
# Makes webpage to ask for choice of file, then 
# uploads, saves to a cleaned-up name, and gives 
# a confirmation page to the uploader and an email
# to the script-owner.
#
# Nathaniel, 2009-03-18.
#

use CGI;
use CGI ':standard';
use CGI ':cgi-lib';
use CGI ':pretty';

# allow uploaded files to be publicly readable ?
$public = 0;
# title for webpage
$title = 'File Upload (to Nathaniel)';
# place to which to make uploads
$ul_root = '/home/nt/public_html/tmp/upload';
# language and character coding
$lang = 'en-GB';
$enc = 'utf-8';

# check the root of the upload area exists
-d $ul_root || die "upload-root \"$ul_root\": $!";


# header for webserver--client
print header (
	'-type'=>'text/html',
	'-content-language'=>$lang,
	'-charset'=>$enc,
	'-content-transfer-encoding'=>$enc
	);

print start_html(
	'-title'=>$title,
	'-encoding'=>$enc,
	'-lang'=>$lang,
	'-style'=>{-src=>'../scripts/nsty1.css'}
	);

print h1($title);

if ( ! param('ulfile') ) {

	print 	p(),
		"\n",
		start_multipart_form(),
	        "File for upload: ",
	        filefield(-name=>'ulfile', -size=>45),
		br(), br(),
		submit(-name=>'',-value=>'Start upload'),
		br(),
	        end_form();

} else { 
	
	print p("Uploading \"" . param('ulfile') . "\"<br>\n");
	
	unless ($frem = param('ulfile'))
		{ die "failed to read remote file"; }

	$_ = $frem;  s/.*\///; 
	if (m/(.+)\.([^.]*)$/) {
		$fnew_b = $1; $fnew_e = $2;
		$fnew_b =~ s/[^[:alnum:]]/_/g;
		$fnew_b =~ s/___+/__/g;
		$fnew_e =~ s/[^[:alnum:]]/_/g;
		$fnew_e =~ s/___+/__/g;
		$_ = $fnew_b . '.' . $fnew_e;
	} else {
	        s/[^[:alnum:]]/_/g;
	        s/___+/__/g;
	}
	$fnew = "\L$_";
	
	$fout = $ul_root . '/' . $fnew;
	open(FOUT, ">$fout") || die "opening output file: $!";
	
	print "<code>\n";
	$chunk = 1024*128;
	$stot = 0;
	while ($slast = read($frem,$tmpread,$chunk)) {
		$stot += $slast;
		print FOUT $tmpread;
	}
	print "</code>\n";	
	close FOUT;

	print p("Finished: $stot bytes read.\n");

	print br();
	print p('Do another <a href="' . url() . '">upload</a>.' . "\n");
	
	if ($public) {
		chmod(0644, $fout);
	} else {
		chmod(0600, $fout);
	}
	open MAIL, "| mail -s \"`hostname`: an upload for `whoami`\" `whoami`" || 
		die "opening pipe to 'mail': $!\n";
	$date = `date`;
	print MAIL "Finished: ${date}Filename: \"$frem\"\n";
	print MAIL "Saved as: \"$fout\"\nSize: $stot bytes.\n\n";
	for ( qw( REMOTE_HOST REMOTE_ADDR HTTP_USER_AGENT SCRIPT_NAME ) ) {	
		printf MAIL "%s = %s\n", $_, $ENV{$_};
	}
		
	close MAIL;
}

print br();
print p('See the <a href="/~nt/tmp/upload">upload directory</a> list.' . "\n");

print end_html;