#!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: $!";

}


#-------------------------------------------------------------
[download]

Although program says file uploaded with correct file path I dont see file at destination. It appears program is actually reaching destination because if file exists at destination upload cancels.

Your help is appreciated.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.