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

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

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

######################## Build the form #########################

my $q = CGI->new;
my $OUTFILE;
my @ts_dir = qw();
my $video = 0;

print $q->header;
warningsToBrowser(1);

print $q->start_html(-title => "Upload file to web server"),
      $q->h3('Import File'),
      $q->start_multipart_form(
                               -name    => 'main_form',
                               -ENCTYPE => 'multipart/form-data',
                              ),
      'Click on the browse button to choose a filename: <BR>',
      $q->filefield(
                    -name      => 'filename',
                    -size      => 75,
                    -maxlength => 80,
                    ),
      $q->hr,
      $q->submit(-value => 'Upload file'),
      $q->hr,
      $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 $source_filename = $q->upload('filename');
	my $untainted_filename;
	my $filename_orig = $source_filename;
	my $dir_path = "";
	my $destination_filename = "";	
	
	if (!$source_filename) {
            print $q->p('You must enter a filename before you can upload it');
            return;
	}
	
	################# CGI Variables to get path and user id ################
	print "<pre>\n";
	my $user_id = "";
	foreach my $key (sort keys(%ENV)) {
	  if ($key =~ /QUERY_STRING/) {
		push(@ts_dir,$ENV{$key});
		#print "$ENV{$key}<p>";
	  }
	  elsif ($key =~ /IWUSER/) {
		$user_id = $ENV{$key};
		#print "$user_id<p>";
	  }
	}
	print "</pre>\n";

	foreach my $d_path (@ts_dir) {
	  $d_path =~ s/&done.*//;
	  $d_path =~ s/.*=\/\/testserver//;  
	  $dir_path = $d_path;
	  #print "Destination Directory:<BR>";
	  #print "$dir_path<p>";
	}
	
	# original vpath 
	my $orig_dir_path = $dir_path;
	
	$dir_path =~ s/\//\\/g;
	$dir_path = "Y:"."$dir_path"."\\";
	
	# absolute directory path
	my $ts_dir_path = $dir_path;
		
	################ Untaint $source_filename #################
	if ($source_filename =~ /\.swf/ || $source_filename =~ /high/ || $source_filename =~ /low/) {
		$video = 1;
		$source_filename =~ /(\w+.\w+)$/;
	    $untainted_filename = $1;
	} else {
		$video = 0;
		$source_filename =~ /(\w+.\w+)$/;
	    $untainted_filename = $1;	
	}
	
	# restore original vpath
	$dir_path = $orig_dir_path;
	
	if ($video == 0 && $dir_path =~ /\/design\/user\/videos/) {
	#print "dir_path: $dir_path\n";
	    die <<"EOT";
Only '.swf' files and files with 'high' or 'low' in the name will be uploaded to /design/user/videos.
EOT
	} 
	elsif ($video == 1 && $dir_path !~ /\/design\/user\/videos/) {
	#print "dir_path: $dir_path\n";
	    die <<"EOT";
Video files not allowed to be uploaded to current destination folder.
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, $ts_dir_path);
	my @files = grep(/\.*$/,readdir(DIR));
	closedir(DIR);
	
	$source_filename = $filename_orig;
	$source_filename =~ s|.*\\||;
	
    # determine if the file already exists on server
	foreach my $ts_file (@files) {  

		if ($ts_file =~ m|$source_filename|) {
			die <<"EOT";
Your upload filename already exists at folder location on server. 
Rename your file, and try again.
EOT
		}
	} # End of foreach my $ts_file (@files) {
							
	$dir_path = $orig_dir_path;
	
	if ($video == 1 && $dir_path =~ /\/design\/user\/videos/) {
		$destination_filename = "Y:\\main\\$untainted_filename";
	}
	elsif ($video == 0 && $dir_path !~ /\/design\/user\/videos/) {
		$dir_path =~ s/\//\\/g;
		$dir_path = "Y:"."$dir_path"."\\";
		print "dir_path: $dir_path<BR>";
		$destination_filename = "$dir_path"."$untainted_filename";
		print "destination_filename: $destination_filename<BR>";	
	}
	
	$source_filename = $filename_orig;
	print "<u>Upload Started:</u> <BR>$source_filename <BR><i>uploading to</i> <BR>$destination_filename<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, '>', $destination_filename) || die "Couldn't open $destination_filename for writing: $!";
	binmode($OUTFILE);
	
	while ($bytesread = read($source_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><u>Upload Completed:</u> <BR>$source_filename <BR><i>uploaded to</i> <BR>$destination_filename ($totalbytes bytes)";
	}
	close $OUTFILE or die "Couldn't close $destination_filename: $!";
}
#-------------------------------------------------------------