Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

(Ovid) Re: File Upload To Selected Directory

by Ovid (Cardinal)
on Sep 26, 2000 at 20:18 UTC ( [id://34034]=note: print w/replies, xml ) Need Help??


in reply to File Upload To Selected Directory

I am not going to downvote your node because you have made it clear that you are new to Perl. However, your script has some serious security problems (amongst other things). It will take a while to work on, so I'll just say that the first two lines of your CGI programs should always be
#!/usr/bin/perl -wT use strict;
Please see perlsec for some details about security. One general rule is that you do not allow anyone to name files on your system. Generate a unique filename and use that. NEVER TRUST USER INPUT!!!

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.
To use the download directory feature, add some HTML like the following:
<SELECT name="path"> <OPTION value="personal">Personal Images</OPTION> <OPTION value="impersonal">Impersonal Images</OPTION> </SELECT>
The Perl resembles the following:
#!/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);
You should also check your directory size, to make sure someone doesn't upload 1000 1 meg files.

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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://34034]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (3)
As of 2024-04-20 13:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found