in reply to Re^2: Upload file through perl-cgi not working
in thread Upload file through perl-cgi not working
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: $!"; } #-------------------------------------------------------------
|
|---|