Thanks guys for your suggestion. I have been busy on other assignment, but know I'm back to finish this code. I have made some changes which appears to work such as, if file exists at destination upload cancels.
However, although program says file uploaded with correct file path I dont see file at destination.
You help is appreciated.
#!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 fi
+le 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 i
+t');
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 tr
+y 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 s
+ure 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 writ
+ing: $!";
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: $!";
}
#-------------------------------------------------------------
|