$1 only gets populated by capturing parens, and you need to use it, before running another regex. By the time you assign $1 to a variable, it is empty again

local $\="\n";
print 33 =~ /\d+/;
print int defined $1;
print 33 =~ /(\d+)/;
print int defined $1;
__END__
1
0
33
1
[download]

$file is tainted, and it will remain tainted, until you assign a $1.... to it

Thanks for your reply anonymous. I made the following change ($file = $1) for your 2nd comment but not sure how to handle your 1st comment. Can you let me know how to implement 1st. Tried a number of modifications but none resolved my issue.

    my $outfile = "$upload_dir"."";
    my ($safe_file_name) = $outfile =~ /([-\@:\/\\\w.]+)$/;
    
    if ($file =~ /swf/ || $file =~ /high/ || $file =~ /low/) {
       $outfile .= $file;
       $safe_file_name = $1;
       $file = $1;
       #if (-e $outfile) {
        #    error_msg("File already exist in destination folder");
       #}
    } else {
       error_msg("Only '.swf' files and files with 'high' or 'low' in 
+the name will be uploaded.");
    }
    if (!$safe_file_name) {
        die qq{Disallowed characters in file $safe_file_name\n};
    }
[download]

Even after you solve the "Insecure dependency" issue, your script will still have a major security issue.

Given these snippets from your code

...

my $file = param("upfile");
my $upload_dir = "Y:\\Test\\user\\videos\\";

...

    my $outfile = "$upload_dir"."";
    my ($safe_file_name) = $outfile =~ /([-\@:\/\\\w.]+)$/;
    
    if ($file =~ /swf/ || $file =~ /high/ || $file =~ /low/) {
       $outfile .= $file;

...

# [ assign some stuff gleaned from $file to $safe_file_name - mlx ]

...
    open (my $fh, '>', $safe_file_name)
      or error_msg("Can't open $safe_file_name for writing: $!");
[download]

I could pass a value of '../../../../../../any/file/I/want.swf' to overwrite any swf file on the y: drive. I don't know enough about the NTFS file system to know if one could span filesystems - to c:/ for example.

"But that only allows you to exploit swf files" you may say. If I discover a directory named 'recipes_using_lowenbrau', I can now overwrite any and all files on your Y: drive (and perhaps others - see comment above about spanning filesystems) with the same technique, by passing a parameter for $file in the form '../../../joes_files/recipes_using_lowenbrau/../../../../now/I/own/all/files'.

You have to be very explicit in what you allow when sanitizing data from the web (or any other untrusted source). Note that I did not say "explicit in what you disallow". It is rarely (perhaps even "never") better to only use a disallow list to remove data, because someone else only has to find one thing that you missed (did you protect against alternate data streams, writing to device files (PRN, anyone?), or other ways of being a nuisance?). Your odds are much better if you list only what you allow, and call everything else invalid.

A common solution is to actually store the file on disk under a generated filename, while storing the original filename, as well as other metadata in a companion file (ex 66696c656e616d65 and 66696c656e616d65.metadata).

$ perl -le " print pack q[H*] => shift " 66696c656e616d65
filename
[download]

Common schemes include using date/time (2011-08-23-03:17:44) combined with userid .... or a UUID

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

}


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