#!I:\Interwoven\TeamSite\iw-perl\bin\iwperl -Tw

use strict;
use warnings;
use diagnostics;

use CGI;
use CGI::Carp qw(fatalsToBrowser set_message);   
set_message("It's not a bug, it's a feature!");

$CGI::POST_MAX = 1024 * 100;  # maximum upload filesize is 100K

sub save_file($);

#
# Build the form
#

my $q = new CGI;
my $OUTFILE;

print $q->header;
print $q->start_html(
	-title => "Upload file to web server",
);
print $q->h3('Import file to videos'),
	  $q->start_multipart_form(
		  -name    => 'main_form',
		  -ENCTYPE => 'multipart/form-data');
print 'Click on the browse button to choose a filename: ',
	  $q->filefield(
		  -name      => 'filename',
	  -size      => 50,
	  -maxlength => 80);
print $q->hr;
print $q->submit(-value => 'Upload the file');
print $q->hr;
print $q->end_form;

#
# Look for uploads that exceed $CGI::POST_MAX
#

if (!$q->param('filename') && $q->cgi_error()) {
	print $q->cgi_error();
	print <<'EOT';
<p>
The file you are attempting to upload exceeds the maximum allowable file size.
<p>
Please refer to your system administrator
EOT
	print $q->hr, $q->end_html;
	exit 0;
}

#
# Upload the file
#

if ($q->param()) {
	save_file($q);
}

print $q->end_html;
exit 0;

#-------------------------------------------------------------

sub save_file($) {

	my ($q) = @_;
	my ($bytesread, $buffer);
	my $num_bytes = 1024;
	my $totalbytes;
	my $filename = $q->upload('filename');
	my $untainted_filename;

	if (!$filename) {
		print $q->p('You must enter a filename before you can upload it');
	return;
	}

	# Untaint $filename

	my $filename_orig = $filename;
	if ($filename =~ /\w+.\w+$/) {
		$filename =~ s|.*\\||;
		$untainted_filename = $filename;
	} else {
		die <<"EOT";
Unsupported characters in the filename "$filename". 
Your filename may only contain alphabetic characters and numbers, 
and the characters '_', '-', '\@', '/', '\\' and '.'
EOT
	}

	if ($untainted_filename =~ m/\.\./) {
		die <<"EOT";
Your upload filename may not contain the sequence '..' 
Rename your file so that it does not include the sequence '..', and try again.
EOT
	}
	
	opendir(DIR, "Y:\\main\\");
	my @files = grep(/\.*$/,readdir(DIR));
	closedir(DIR);
	
	$filename = $filename_orig;
	$filename =~ s|.*\\||;
	
	foreach my $ts_file (@files) {  

		if ($ts_file =~ m|$filename|) {
			die <<"EOT";
Your upload filename already exists at folder location on server. 
Rename your file, and try again.
EOT
		}
	} # End of foreach my $file (@files) {
					
	
	my $filename = $filename_orig;
	
	my $file = "Y:\\main\\$untainted_filename";

	print "Uploading $filename to $file<BR>";

	# If running this on a non-Unix/non-Linux/non-MacOS platform, be sure to 
	# set binmode on the $OUTFILE filehandle, refer to 
	#    perldoc -f open 
	# and
	#    perldoc -f binmode

	open ($OUTFILE, '>', '$file') or die "Couldn't open $file for writing: $!";
	binmode($OUTFILE);
	
	while ($bytesread = read($filename, $buffer, $num_bytes)) {
		$totalbytes += $bytesread;
		print $OUTFILE $buffer;
	}
	die "Read failure" unless defined($bytesread);
	unless (defined($totalbytes)) {
		print "<p>Error: Could not read file ${untainted_filename}, ";
		print "or the file was zero length.";
	} else {
		print "<p>Done. File $filename uploaded to $file ($totalbytes bytes)";
	}
	close $OUTFILE or die "Couldn't close $file: $!";

}


#-------------------------------------------------------------