Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Page 1 of 2 12 LastLast
Results 1 to 15 of 18
  1. #1
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts

    single file-uploader into multiple help.

    Hi,

    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.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #2
    Senior Coder
    Join Date
    Mar 2006
    Posts
    1,274
    Thanks
    2
    Thanked 39 Times in 38 Posts
    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;
       }
    }

  • #3
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    Kevin, thank you very much.

    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
    Last edited by bazz; 03-03-2009 at 09:38 AM.
    "The day you stop learning is the day you become obsolete"! - my late Dad.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #4
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    yeh, disabling this and redfining the $type, enabled to script to run and upload the file.

    I think that because it is behind ssl and password protected, for sensible businesses, I might not need to fuss about the mime type.

    what you think?

    Can the mime-type be used to power a conditional statement as to which directory the files should be loaded?

    bazz
    "The day you stop learning is the day you become obsolete"! - my late Dad.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #5
    Senior Coder
    Join Date
    Mar 2006
    Posts
    1,274
    Thanks
    2
    Thanked 39 Times in 38 Posts
    Yes, the MIME type could be used to direct files to specific directories.

    To me it looks like $filename is not defined in the line you posted. $type is not a hash reference, it is a simple scalar.

  • #6
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    Hi,

    well $filename seems to be defined because it prints out the filename.
    Edit:
    However, I do not seem to have UploadInfo sub routine in that script.



    bazz
    Last edited by bazz; 03-04-2009 at 04:56 AM.
    "The day you stop learning is the day you become obsolete"! - my late Dad.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #7
    Senior Coder
    Join Date
    Mar 2006
    Posts
    1,274
    Thanks
    2
    Thanked 39 Times in 38 Posts
    uploadInfo is a function/method of the CGI module.

  • #8
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    doh! I see that now that I have woken up.

    Quote Originally Posted by http://perldoc.perl.org/CGI.html#CALLING-CGI.PM-ROUTINES
    To retrieve this information, call uploadInfo(). It returns a reference to an associative array containing all the document headers.
    Now, it seems that the defualt error message outputs, even if I put that line in a conditional - to try to output a different message.


    So I am out of ideas and ask what I should try next. Perhaps there might be a server setting I should change?

    bazz
    "The day you stop learning is the day you become obsolete"! - my late Dad.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #9
    Senior Coder
    Join Date
    Mar 2006
    Posts
    1,274
    Thanks
    2
    Thanked 39 Times in 38 Posts
    Since there is no default error message, post the exact error message you get when you run the script.

  • #10
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    Hi,

    The error message is

    Code:
    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
    Last edited by bazz; 03-04-2009 at 11:47 PM.
    "The day you stop learning is the day you become obsolete"! - my late Dad.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #11
    Senior Coder
    Join Date
    Mar 2006
    Posts
    1,274
    Thanks
    2
    Thanked 39 Times in 38 Posts
    Well, I tested with an undefined value and that is the error I also get:


    Software error:
    Can't use an undefined value as a HASH reference at c:\PROGRA~1\APACHE~1\APACHE\HTDOCS\CGI-BIN\LOCAL_UP.PL line 217.
    Last edited by KevinADC; 03-05-2009 at 02:32 AM.

  • #12
    Senior Coder
    Join Date
    Mar 2006
    Posts
    1,274
    Thanks
    2
    Thanked 39 Times in 38 Posts
    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.

  • #13
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    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.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #14
    Master Coder
    Join Date
    Apr 2003
    Location
    in my house
    Posts
    5,211
    Thanks
    39
    Thanked 201 Times in 197 Posts
    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.

    Why do some people say "I don't know for sure"? If they don't know for sure then, they don't know!
    Useful MySQL resource
    Useful MySQL link

  • #15
    New Coder
    Join Date
    Mar 2009
    Location
    Fabric Covered Box
    Posts
    69
    Thanks
    1
    Thanked 16 Times in 14 Posts
    Are you allowed to install new modules?

    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.


  •  
    Page 1 of 2 12 LastLast

    Posting Permissions

    • You may not post new threads
    • You may not post replies
    • You may not post attachments
    • You may not edit your posts
    •