This is a single file uploader I have got working. got it off the web and modded some bits I thought were dodgey. (double quotes etc)
Now that it works for single images, I need to make it allow multiple files to be uploaded and it works as far as one specific line which I have highlighted in red. actually, it creates the 2 files online but with '0' bytes in each.
Code:
$CGI::POST_MAX = 1024 * 5000;
my $safe_filename_characters = 'a-zA-Z0-9_.-';
my $upload_dir = "/var/www/vhosts/example.com/subdomains/cms/httpdocs/upload";
my $cgi = new CGI;
my @filename = $cgi->param('photo'); # this is correct isn't it?
my @uploaded_filename;
foreach my $filename (@files_for_up)
{
if ( !$filename || $filename eq '' )
{
print $cgi->header ( );
print "There was a problem uploading your photo (try a smaller file).";
exit;
}
my ( $name, $path, $extension ) = fileparse ( $filename, '\..*' );
$filename = $name . $extension;
$filename =~ tr/ /_/;
$filename =~ s/[^$safe_filename_characters]//g;
if ( $filename =~ /^([$safe_filename_characters]+)$/ )
{
$filename = $1;
}
else
{
die "Filename contains invalid characters";
}
my $upload_filehandle = $cgi->upload('photo');
open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "$!";
binmode UPLOADFILE;
while ( <$upload_filehandle> )
{
print UPLOADFILE;
}
push (@uploaded_filename, $filename );
close UPLOADFILE;
}
__________________
"The day you stop learning is the day you become obsolete"! - my late Dad.
Here is another one I wrote (the one you have looks like part of one I wrote). See if you can use this one:
Code:
#!usr/bin/perl -wT
# File Uploader, v 1.0
use strict;
use CGI;
use File::Basename;
use Fcntl qw(:DEFAULT :flock);
# Uncomment next line only for debugging script
use CGI::Carp qw/fatalsToBrowser/;
my $revision = '$Id: up.pl, v 1.0 2006/09/11 11:23:09 kevinadc Exp $';
my $VERSION = '1.0';
$CGI::POST_MAX = 1024 * 5000; #adjust as needed (1024 * 5000 = 5MB)
$CGI::DISABLE_UPLOADS = 0; #1 disables uploads, 0 enables uploads
# USER CONFIGURATION SECTION
# $upload_dir is the path to the directory where files will
# be saved. The directory needs to have write permissions.
my $upload_dir = '/var/www/vhosts/example.com/subdomains/cms/httpdocs/upload';
# $url_uploads is the public URL of the file uploads directory
my $url_uploads = 'http://www.exampl.com/upload';
# $url_upload_form is the public URL of the up.html page
my $url_upload_form = 'http://www.example.com/up.html';
# $error_log_path is the path to the error log file
my $error_log_path = '/var/www/vhosts/example.com/subdomains/cms/httpdocs/upload/errors/error_log.txt';
# @ext_list is a list of filetypes/extensions that are allowed to be uploaded.
# Leave blank ( @ext_list = (); ) to allow all filestypes/extensions.
# Add or remove file extensions per your requirements.
# The extensions should be written in all lower-case letters.
my @ext_list = qw(doc jpeg jpg gif png art txt html htm shtml shtm php zip tar wmv log mpg mpeg mp3);
# @mime_types is a list of MIME types that are allowed to be uploaded.
# Leave blank ( @mime_types = (); ) to allow all mime types.
# Add or remove MIME types per your requirement.
my @mime_types = qw(image text);
# A list of referring hosts. The names or IP addresses of all the systems
# that will host HTML forms that use to this program.
# NOT RECOMMENDED!! - Leave blank to allow any host to use this program.
my @referers = qw(www.example.com);
# Sometimes, for various reasons (ie: proxies or firewalls), the HTTP_REFERER information
# is not in the HTTP header. Setting $allow_empty_ref to 1 (one) will bypass checking
# the HTTP_REFERER if it's not in the header. Setting it to 0 (zero) will
# print an error about about an 'invalid referer' if there is no HTTP_REFERER.
my $allow_empty_ref = 1;
# $log_bad controls logging errors to a file. You can use the log to try and determine
# if the script is being abused.
# 1 (one) enables logging errors
# 0 (zero) disables logging errors
my $log_errors = 1;
# $over_write controls if a file being uploaded will overwrite a file
# already on the server that has the same name.
# 1 disables file overwriting
# 0 allows file overwriting.
my $over_write = 1;
# $style is the URL of a CSS stylesheet which will be used for script
# generated messages. This probably want's to be the same as the one
# that you use for all the other pages. This should be a local absolute
# URI fragment.
my $style = '/css/style.css';
# $filename_characters is a list of characters to allow/keep in filenames.
# Add or remove characters per your requirements.
# Put a dash at the end if you want to allow it in filenames.
# NOT RECOMMENDED!! - Leave blank ( $filename_characters = ''; ) to allow all characters.
my $filename_characters = 'a-zA-Z0-9_.-';
# Maximum number of files allowed to be uploaded per session.
# Increase or decrease quantity as needed.
# Should match the number of file fields in the up.html form used for uploading files.
# If you set it to 0 (zero) no files will be uploaded.
my $max_upload_fields = 5;
######################################
# Nothing to edit below unless you #
# needed to change how script works. #
######################################
my $query = CGI->new;
# check for CGI.pm version 2.47 or higher
($CGI::VERSION >= 2.47) or
error('The version of CGI.pm is too old.',"You must have verison 2.47 or higher to use this script.");
# print error message and exit script if uploading is disabled
($CGI::DISABLE_UPLOADS == 0) or
error('Sorry, file uploading is temporarily disabled','Site maintenance in progress. Check back later.' );
unless ($max_upload_fields >= 1) {
print $query->header('text/html'),
$query->start_html(-title=>'Error!', -style => { src => $style } ),
qq~<h3>Error: \$max_upload_fields must be 1 (one) or more.</h3>~,
$query->end_html;
$query->delete_all();
exit(0);
}
my $remote_host = $query->referer();
unless (check_referer($remote_host)) {
error('Invalid Referer','You are not authroized to use this program.' );
}
my @filehandles = $query->upload('photo') or error('No files selected for uploading.','Return to the upload form and select a file(s).' );
if (scalar @filehandles > $max_upload_fields) {
@filehandles = @filehandles[0..$max_upload_fields-1];
}
my @fail = ();
my @success = ();
chdir($upload_dir) or error("Unable to find/open directory [$upload_dir]",$!);
UPLOADFILES:
foreach my $filename (@filehandles) {
# first split filename(s) into path/name/extension
# so we can check the extension case insensitively
my $lc_filename = lc($filename);
my (undef,undef,$lc_ext) = fileparse($lc_filename,@ext_list);
my ($name,undef,$ext) = fileparse($filename,@ext_list);
# see if we get a MIME content type sent with the file
# if not we can't check for MIME types
my $type = $query->uploadInfo($filename)->{'Content-Type'};
# check for allowable MIME types
if ($type && @mime_types) {
my $bad_mime = 1;
for (@mime_types) {
$bad_mime = 0 if $type =~ m|^$_/|i;
last unless $bad_mime;
}
if ($bad_mime) {
push (@fail,"$name$ext - MIME type '$type' is not allowed");
next UPLOADFILES;
}
}
# check for allowable file extenstions
if (@ext_list) {
unless ($lc_ext) {
my $suffix = ($name =~ /\Q([^.]+)\E$/) ? $1 : 'unknown';
push (@fail,"$name - file extension '.$suffix' not allowed");
next UPLOADFILES;
}
}
$name = clean_untaint_name("$name$ext") or error('The filename is not valid.','Illegal characters in filename. Rename the file and try again.');
if ($over_write && -e $name) {
push (@fail,"File '$name' already exists. Rename file and try again.");
next UPLOADFILES;
}
# all good! upload files!
sysopen(UPLOAD, "$upload_dir/$name", O_RDWR|O_CREAT) or error("Unable to open directory [$upload_dir]",$!);
binmode(UPLOAD);
print UPLOAD while (<$filename>);
close(UPLOAD);
sleep 1;
#check for zero size files
if (-s $name <= 0) {
unlink($name) or error('Unable to delete empty file.',$!);
push (@fail,"$name - empty files not allowed");
}
else {
push @success,$name;
}
}
# check to see if upload was too large
if ($query->cgi_error()){
my $error = $query->cgi_error();
if ($error =~ /^413\b/) {
error("The file(s) you are uploading are too large!",
"Total size of all files is limited to $CGI::POST_MAX bytes per session.");
}
else {
error("An unknown error has occured.",
"Try uploading the file(s) again. Contact the webmaster if the error persists.");
}
}
print $query->header('text/html');
if (@success) {
print $query->start_html(-title=>'Error!', -style => { src => $style } ),
qq~\n<h3>@{[scalar @success]} files successfully uploaded</h3><hr />
<ul>
~;
print qq~ <li><a href="$url_uploads/$_">$url_uploads/$_</a></li>\n~ for @success;
print q~</ul>
~;
if (@fail) {
local $" = ' - ';
print qq~<hr /><h3>@{[scalar @fail]} files were not uploaded.</h3><hr />
<h4>Possible Reasons:
<ul>
<li>Files can not be empty</li>
<li>File must have a valid file extension: @ext_list</li>
<li>Files must be a valid MIME type: @mime_types</li>~;
print q~ <li>Filename must not already exist on server</li>~ if $over_write;
print q~ <li>See detailed reason below</li>
</ul>
Disallowed File(s):
<ul>
~;
print qq~ <li>$_</a></li>\n~ for @fail;
}
print qq~</ul></h4><hr />Return to uploader: <a href="$url_upload_form">$url_upload_form</a>~,
$query->end_html;
log_error(@fail) if ($log_errors);
}
else {
local $" = ' - ';
print $query->start_html(-title=>'Error!', -style => { src => $style } ),
qq~\n<h3>Error: No files were uploaded.</h3>
<h3>Possible Reasons:
<ul>
<li>Files can not be empty</li>
<li>File must have a valid file extension: @ext_list</li>
<li>Files must be a valid MIME type: @mime_types</li>~;
print q~ <li>Filename must not already exist on server</li>~ if $over_write;
print q~ <li>See detailed reason below</li>
</ul>
Disallowed File(s):
<ul>
~;
print qq~ <li>$_</li>\n~ for @fail;
print qq~</ul></h3><hr />Return to uploader: <a href="$url_upload_form">$url_upload_form</a>~,
$query->end_html;
log_error(@fail) if ($log_errors);
}
sub error {
my ($error, $status) = @_;
print $query->header(-type=>'text/html'),
$query->start_html(-title=>'Error!', -style => { src => $style } ),
qq~\n<h3>Error: $error</h3>
<h3>Reason: $status</h3>
<p>Return to uploader: <a href="$url_upload_form">$url_upload_form</a></p>~,
$query->end_html;
log_error($error) if ($log_errors);
$query->delete_all();
exit(0);
}
sub check_referer {
return 1 unless scalar @referers;
my $referer = shift;
unless ($referer) {
return ($allow_empty_ref ? 1 : 0);
}
if ($referer =~ m#^https?://([^/]*\@)?([\w.-]+)#i) {
my $host = $2;
foreach my $ref (@referers) {
if ($host =~ m/\Q$ref\E$/i) {
return 1;
}
}
}
else {
return 0;
}
}
sub log_error {
my @errors = @_;
sysopen (LOG, $error_log_path, O_RDWR|O_APPEND|O_CREAT) or die "Can't open the error log: $!";
eval {flock (LOG, LOCK_EX)};
foreach my $lines (@errors) {
print LOG "$lines|",scalar gmtime(),"|$ENV{REMOTE_ADDR}|$ENV{SERVER_NAME}|$ENV{HTTP_HOST}|$ENV{HTTP_REFERER}|$ENV{HTTP_USER_AGENT}|$ENV{SCRIPT_NAME}\n";
}
close(LOG);
}
sub clean_untaint_name {
my $name = shift;
return 0 unless $name;
if ($filename_characters) {
$name =~ s/[^$filename_characters]//g;
if ($name =~ /^([$filename_characters]+)$/) {
$name = $1;
return $name;
}
}
else {
$name =~ /^\Q(.+)\E$/;
$name = $1;
return $name;
}
}
I have set most of the server specific stuff and am getting an error on line 232.
Can't use an undefined value as a HASH reference at file_uploader.pl line 232.
what have I missed?
here is the section
Code:
# see if we get a MIME content type sent with the file
# if not we can't check for MIME types
my $type = $query->uploadInfo($filename)->{'Content-Type'};
bazz
__________________
"The day you stop learning is the day you become obsolete"! - my late Dad.
Software error:
Can't use an undefined value as a HASH reference at file_uploader.pl line 235.
That seems to relate to the $filename var as you suggested before. I wonder though, if there is another way to get mime_types before uploading to the dir online. I have searched, with no results.
bazz
__________________
"The day you stop learning is the day you become obsolete"! - my late Dad.
My only suggestion is to try debugging by printing $filename as the script runs:
Code:
UPLOADFILES:
foreach my $filename (@filehandles) {
print "[$filename]<br/>\n";
# first split filename(s) into name/extension
# so we can check the extension case insensitively
my $lc_filename = lc($filename);
The square brackets [] are there so you can see if a value is blank. Have you changed anything in the script? I have never had trouble running this script.
The script is as you gave it to me but for having put it into a sub routine.
$filename is there (see post #6) and I have tested it again and it is showing.
I have just copied and pasted the script again, and it does the same thing as before. It defines the $filename and, if I just declare 'my $type;' and remove the uploadInfo query line, the script runs and uploads the files. It just has no way of knowing which file is which type so I currently, I just put them into the same dir. I owuld like to have the one script, which enables uplaods and which determines which directory the files go into, whether they are pdf, jpg,txt etc.
I shall get onto my isp and see if there is a server config that should be changed. waaaay outside my knowledge area. Do you know of any that might be relevant?
bazz
__________________
"The day you stop learning is the day you become obsolete"! - my late Dad.
OK, I got it sorted. works really well. I just need to add the feature wherein, each mime-type is sent to its own dir.
@Kevin: do you know if when uploading an image there is any way to capture its dimensions as well as the mime type? I'd like to send images of various sizes to their respective directories.
bazz
__________________
"The day you stop learning is the day you become obsolete"! - my late Dad.
Image::Size is quick, accurate, and will work directly with the filehandles CGI gives.
Code:
my($width,$height,$type)=imgsize($filename);
unless($width){
# not an image
}
elsif($width < 40 && $height < 40 && $type=~/gif|jpeg/i)
$upload_dir .='/thumbs';
}
else{
# etc.
}
# all good! upload files!
sysopen(UPLOAD, "$upload_dir/$name${x}_$y", O_RDWR|O_CREAT) or error("Unable to open directory [$upload_dir]",$!);
You ought to consider using something like File::MMagic to determine the filetypes. The MIME Content-Type that CGI gives you is just a guess the uploading browser made based on the file extension.
Before you post, read our: 
