#!/usr/bin/perl -wT
use strict;
[download]

Also, you should check your open statement for success.

I'll post more later after I've cleaned up your code a bit.

Cheers,
Ovid

Update:Here's a somewhat cleaner version of your script. It has the following features (but is untested!!!):

• It passes strict and warnings.
• Random filenames are created, thereby avoiding security a huge security problem in allowing user data near the shell.
• It has a max file size, so users can't upload 100 meg files.
• More accurate checking of MIME type.
• Selected download directories.

<SELECT name="path">
<OPTION value="personal">Personal Images</OPTION>
<OPTION value="impersonal">Impersonal Images</OPTION>
</SELECT>
[download]

#!/usr/bin/perl -wT
use strict;
use CGI;
use Fcntl;

use constant BUFFER_SIZE   => 16_384;       # Amount of upload file to
+ read at one time
use constant MAX_FILE_SIZE => 1_048_576;    # This is the filesize upl
+oad limit
use constant UPLOAD_DIR    => "/home/sites/web/directory/";

$CGI::DISABLE_UPLOADS      = 0;             # Temporarily reenable upl
+oads
$CGI::POST_MAX             = MAX_FILE_SIZE; # This will stop someone f
+rom uploading
                                            # a fifty meg file to your
+ system

my $req      = CGI->new; 
my $theext   = "gif";
my $donepage = "up2.html";

my %upload_path = {personal   => 'personal/',
                   impersonal => 'anotherpath/'};

my $path = $req->param('path');

if (! exists $upload_path{$path}) {
    # Oops!  It's not in our hash.  Someone was being naughty!
    print $req->redirect("some_error_page.html");
    exit;
}
$path = $upload_path{$path};

UPLOAD_FILE:
{
    for my $onnum (1..10) {
        my $file = $req->param("FILE$onnum") or next UPLOAD_FILE;
        if ($file) {
            my $buffer;
            my $file_handle = $req->upload( $file );
            my $format = $req->uploadInfo($file)->{'Content-Type'};
        
            # In the following regex, we're getting the image type of 
+the MIME type.
            # This is better than checking the extension because if th
+ey upload from
            # a system that doesn't use extensions - or if the user's 
+redefined their
            # extensions, we'd have problems.
            $format    =~ s!^image/([a-zA-Z]+)$!$1!;
            if ($format !~ /$theext/o) {
                next UPLOAD_FILE;
            }
        
            my $fileName = "";
            
            # Create a random filename.  Keep running the loop if the 
+filename exists,
            # or if $fileName is false.
            while (! $fileName or -e UPLOAD_DIR.$path.$fileName) {
                $fileName = "";
                my @myarray=('a'..'z','A'..'Z','1'..'9');
                for (1..8) {
                    $fileName .= $myarray[rand(@myarray)];
                }
                $fileName .= ".$theext";
            }
            
            # This will create the new file
            sysopen OUTFILE, UPLOAD_DIR . $path . $fileName, O_CREAT o
+r die "Can't open UPLOAD_DIR$path$fileName: $!";
            
            while ( read( $file_handle, $buffer, BUFFER_SIZE ) ) { 
                print OUTFILE $buffer; 
            }
            close (OUTFILE); 
        }
    }
}

# Send them to the confirmation page.
print $req->redirect($donepage);
[download]

You'll also need CGI.pm version 2.47 or above to use the upload method.

I've also added a quick hack to allow users to choose subdirectories from a pre-approved list. It's untested and not great, but again, no user data gets to the shell. Using this method, you'll need to create those download directories in advance and make sure that they are writeable by the same user your script is running under (probably user "nobody").

Join the Perlmonks Setiathome Group or just go the the link and check out our stats.

You basically want to do something like this:

open (OUTFILE, ">$basedir/$fileName");
[download]

open (OUTFILE, ">$basedir/$subdir/$fileName");
[download]

mkdir("$basedir/$subdir") unless -d "$basedir/$subdir";
open (OUTFILE, ">$basedir/$subdir/$fileName") 
   or die "Could not open $basedir/$subdir/$fileName: $!";
[download]

Many will tell you not to allow the user to select filename/path for their upload. (You decide, and save their choices in a database to let them retrieve the file based on the "vitural" path they selected). In many cases though that's not practical. So make sure the filename is COMPLETELY safe for your system if you can't avoid using the user selections. This means:

1. Making sure there aren't more "\" in the path.
2. Making sure the path has only valid characters
3. Making sure the filename is valid, with only valid characters
4. Making sure the file doesn't already exist (unless you want to allow overwriting)
5. Making sure the path doesn't contain ".."

You can see File Upload Security Question by Ovid for a more intensive analysis of how paranoid you need to be about security.

Oh there are more, lots more. For instance if you just do:

  open (FILE, $file) or die "Cannot read $file: $!";
[download]

someone can pass a string that turns into a system command. You won't ever catch all of the possible nasties (fun stuff can be done with \0 for instance) which is why you need to make a list of what you explicitly permit and only pass that, rather than plugging the holes individually as you learn them.

you need to make a list of what you explicitly permit and only pass that,

There is no way to say it better than that, so I'm just replying to draw extra attention to it. tilly++

Also, let me point out that the File Upload Security Question was posted by me 3 1/2 months ago. Compare my upload script (and stupid newbie comments) from then as compared to now and you'll see how fast your Perl knowledge can grow on a steady diet of Perlmonks and caffeine :)

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just go the the link and check out our stats.