Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

CGI::Safe and easy file uploading

by Ovid (Cardinal)
on Aug 14, 2001 at 03:26 UTC ( #104626=sourcecode: print w/replies, xml ) Need Help??
Category: CGI Programming
Author/Contact Info Ovid
Description:

Update: This module is now available from the CPAN. Go there for the latest and greatest update and be sure to read the docs for more information (quite a bit has changed).

The CGI::Safe module interits from CGI.pm but makes the environment a bit safer. POST_MAX is already set and DISABLE_UPLOADS is set to true. Of course, these may be overriden by the user. Also, as suggested by perlsec, the following keys are deleted from %ENV: qw/ IFS CDPATH ENV BASH_ENV /.

Further, even though this is not strictly related to safe CGI programming, I have added a generic file upload utility that will allow users to easily upload files, specify the file source and the allowed file formats.

Amusing side note: this module disables file uploading by default. While working on the upload capability, I had forgotten to re-enable file uploading and spent 15 minutes of debugging trying to figure out why I couldn't get any files to upload :)

################################
package CGI::Safe;
################################
$VERSION = 1.0;

use strict;
use Carp;
use CGI;
use Exporter;
use vars qw/ @ISA @EXPORT_OK/;
@ISA = qw/ CGI Exporter /;

@EXPORT_OK = qw/ get_upload /;

INIT {
    # Establish some defaults
    delete @ENV{ qw/ IFS CDPATH ENV BASH_ENV / }; # Clean up our Envir
+onment
    $CGI::DISABLE_UPLOADS = 1;                    # Disable uploads
    $CGI::POST_MAX        = 512 * 1024;           # limit posts to 512
+K max
}

sub new {
    my ( $self, %args ) = @_;
    $CGI::DISABLE_UPLOADS = $args{ DISABLE_UPLOADS } if exists $args{ 
+DISABLE_UPLOADS };
    $CGI::POST_MAX        = $args{ POST_MAX }        if exists $args{ 
+POST_MAX };
    return ( exists $args{ source } ) ? CGI::new( $self, $args{ source
+ } ) :
                                        CGI::new( $self );
}

sub get_upload {
    my $self;
    $self = shift if ref $_[0]; # can be tossed because hash keys can'
+t be refs
                                # this will occur if called in OO fash
+ion
    my %specs = @_;

    if ( ! exists $specs{ cgi } ) {
        if ( defined $self ) {
            $specs{ cgi } = $self;
        } else {
            # Here, we're holding our breath and praying this doesn't 
+break in future releases.
            # CGI.pm uses objects internally, even if called through t
+he functional interface.
            # self_or_default returns that object
            $specs{ cgi } = &CGI::self_or_default;
        }
    }
    
    # if the cgi value is not a reference and not a cgi object ...
    # This should *not* occur
    if (  ! ( ref $specs{ cgi } and $specs{ cgi }->isa( 'CGI' ) ) ) {
        croak '"cgi => $cgi_obj": The \'cgi\' value was not a CGI obje
+ct';
    }
    
    croak '&get_upload expects a hash with "file_name => $file_name"' 
+unless exists $specs{ file_name };
    
    my %data = ( error  => 0,
                 file   => undef,
                 format => undef );

    # Not using CGI::upload as I've had (and seen) problems with vario
+us versions of this
    my $fh = $specs{ cgi }->param( $specs{ file_name } );

    if ( $specs{ cgi }->cgi_error ) {
        $data{ error } = 'Error uploading file: ' . $specs{ cgi }->cgi
+_error;
        return \%data;
    }
    if ( ! defined $fh ) {
        $data{ error } = 'No file uploaded.';
        carp "No file uploaded.  Did you remember 'enctype=\"multipart
+/form-data\"' in your <form> tag?";
        if ( $CGI::DISABLE_UPLOADS ) {
            carp "\$CGI::DISABLE_UPLOADS is set to $CGI::DISABLE_UPLOA
+DS.  This may be why no file was uploaded."
        }
        return \%data;
    }

    $data{ format } = $specs{ cgi }->uploadInfo( $fh )->{ 'Content-Typ
+e' };
    if ( exists $specs{ format } ) {
        my @format = ref $specs{ format } eq 'ARRAY' ? @{ $specs{ form
+at } } 
                                                     :    $specs{ form
+at } ;
        my $re_format = quotemeta $data{ format };
        if ( ! grep { /$re_format/ } @format ) {
            my $formats = ref $specs{ format } eq 'ARRAY' ? join ' or 
+', @{ $specs{ format } } 
                                                          :           
+      $specs{ format } ;
            $data{ error } = "Illegal file format: $data{ format }.  E
+xpecting: $formats.";
            return \%data;
        }
    }

    binmode $fh;
    my $file = '';
    binmode $file;
    {
        my $data = '';
        while ( read( $fh, $data, 1024 ) ) {
            $file .= $data;
        }
    }

    if ( ! $file ) {
        $data{ error } = 'No file uploaded.';
        return \%data;
    }

    $data{ file } = $file;
    return \%data;
}

"Ovid";

__END__

=head1 NAME

CGI::Safe - Safe method of using CGI.pm.  This is pretty much a two-li
+ne change
for most CGI scripts.

=head1 SYNOPSIS

 use CGI::Safe;
 my $q = CGI::Safe->new();

=head1 DESCRIPTION

If you've been working with CGI.pm for any length of time, you know th
+at it allows 
uploads by default and does not have a maximum post size. Since it sav
+es the uploads 
as a temp file, someone can simply upload enough data to fill up your 
+hard drive to 
initiate a DOS attack. To prevent this, we're regularly warned to incl
+ude the 
following two lines at the top of our CGI scripts:

 $CGI::DISABLE_UPLOADS = 1;          # Disable uploads
 $CGI::POST_MAX        = 512 * 1024; # limit posts to 512K max

As long as those are their before you instantiate a CGI object (or bef
+ore you access 
param and related CGI functions with the function oriented interface),
+ you have pretty 
safely plugged this problem. However, most CGI scripts don't have thes
+e lines of code. 
Some suggest changing these settings directly in CGI.pm. I dislike thi
+s for two reasons:

1.  If you upgrade CGI.pm, you might forget to make the change to the 
+new version. 

2.  You may break a lot of existing code (which may or may not be a go
+od thing depending 
upon the security implications). 

Hence, the C<CGI::Safe> module.  It will establish the defaults for th
+ose variables and 
require virtually no code changes.  Additionally, it will delete C<%EN
+V> variables listed
in C<perlsec> as dangerous.

=head1 Objects vs. Functions

Some people prefer the object oriented interface for CGI.pm and others
+ prefer the function
oriented interface.  Naturally, the C<CGI::Safe> module allows both.  
+There is also a 
C<CGI::Safe::get_upload> function that can be imported or used in OO f
+ashion.

 use CGI::Safe;
 my $q = CGI::Safe->new( DISABLE_UPLOADS = 0 );
 my $file = $q->get_upload( file_name => 'somefilename' );

Or:

 use CGI::Safe qw/ :standard get_upload /;
 $CGI::DISABLE_UPLOADS = 0;
 my $file = get_upload( file_name => 'somefilename' );

=head1 Uploads and Maximum post size

As mentioned earlier, most scripts that do not need uploading should h
+ave something like the
following at the start of their code to disable uploads:

 $CGI::DISABLE_UPLOADS = 1;          # Disable uploads
 $CGI::POST_MAX        = 512 * 1024; # limit posts to 512K max

The C<CGI::Safe> sets these values in an C<INIT{}> block.  If necessar
+y, the programmer can
override these values two different ways.  When using the function ori
+ented interface, if needing
file uploads and wanting to allow up to a 1 megabyte upload, they woul
+d set these values directly
I<before> using C<CGI::Safe::get_upload> or using any of the CGI.pm CG
+I functions:

 use CGI::Safe qw/ :standard get_upload /;
 $CGI::DISABLE_UPLOADS = 0;
 $CGI::POST_MAX        = 1_024 * 1_024; # limit posts to 1 meg max
 my $file = get_upload( file_name => 'somefilename' );

If using the OO interface, you can set these explicitly I<or> pass the
+m as parameters to the
C<CGI::Safe> constructor:

 use CGI::Safe;
 my $q = CGI::Safe->new( DISABLE_UPLOADS = 0,
                          POST_MAX        = 1_024 * 1_024 );
 my $file = $q->get_upload( file_name => 'somefilename' );

=head1 CGI.pm objects from input files and other sources

You can instantiate a new CGI.pm object from an input file, properly f
+ormatted query string passed
directly to the object, or even a has with name value pairs representi
+ng the query string.  To
use this functionality with the C<CGI::Safe> module, pass this extra i
+nformation in the C<source> key:

 use CGI::Safe;
 my $q = CGI::Safe->new( source = $some_file_handle );

Alternatively:

 use CGI::Safe;
 my $q = CGI::Safe->new( source => 'color=red&name=Ovid' );

=head1 File uploading

This is not really necessary in the C<CGI::Safe> module, but it is inc
+luded as many, many programmers
have difficulty with this.  C<CGI::Safe::get_upload> has takes three n
+amed parameters (e.g. pass it a 
hash), two of which are optional.

=over 4

=item 1 I<file_name>

This specifies the name of the file in the "file" field of the of the 
+form.

=item 2 I<format>

This parameter is optional.  Pass it a scalar with an allowed file typ
+e or a list reference with multiple
allowed file types.  If the uploaded file doesn't match one of the sup
+plied types, will return an error.
By leaving this parameter off, C<CGI::Safe::get_upload> will return an
+y type of file.

=item 3 I<cgi>

If, for some reason, you are using multiple CGI objects, you can speci
+fy the CGI object which has the file
in question.  This parameter is also optional.  It should seldom, if e
+ver, be used.

=back

=head2 Using file uploading

Basic use:

 use CGI::Safe;
 my $q    = CGI::Safe->new( DISABLE_UPLOADS => 0 );
 my $file = $q->get_upload( file_name => 'somefilename' );

Here's an example with all parameters specified:

 use CGI::Safe;
 my $q = CGI::Safe->new( DISABLE_UPLOADS => 0 );
 my $file = $q->get_upload( file_name => 'somefilename',
                            format    => [ 'image/gif', 'image/jpeg' ]
+,
                            cgi       => $cgi ); # use this only if yo
+u have another cgi object instantiated
                                                 # and it has the uplo
+ad data that you need

=head2 Return value from uploading

C<CGI::Safe::get_upload> returns a scalar with a reference to an anony
+mous has with three keys:

=over 4

=item 1 error

This key will contain a human readable error message that will explain
+ why the upload didn't succeed.
It's value will be 0 (zero) if the upload was successful.

=item 2 file

This will be the actual contents of the file.

=item 3 format

This is the "content-type" of the file in question.  For example, a GI
+F file will have a format of
'image/gif'.

=back

=head2 Using the return values from uploading

 use CGI::Safe;
 my $q = CGI::Safe->new( DISABLE_UPLOADS => 0 );
 my $file = $q->get_upload( file_name => 'somefilename' );

 if ( $file->{ error } ) {
    print $q->header,
          $q->start_html,
          $q->p( $file->{ error } ),
          $q->end_html;
 } else {
    print $q->header( -type => $file->{ format } ),
           $file->{ file };
 }
 
=head1 COPYRIGHT

Copyright (c) 2001 Curtis A. Poe.  All rights reserved.
This program is free software; you may redistribute it and/or modify i
+t under 
the same terms as Perl itself

=head1 AUTHOR

Curtis A. Poe <poec@yahoo.com>
Address bug reports and comments to: poec@yahoo.com.  When sending bug
+ reports,
please provide the version of CGI.pm, the version of CGI::Safe, the ve
+rsion 
of Perl, and the version of the operating system you are using.

=head1 BUGS

2001/07/13 There are no known bugs at this time.  However, I am somewh
+at concerned
about the use of this module with the function oriented interface.  CG
+I.pm uses
objects internally, even when using the function oriented interface (w
+hich is part
of the reason why the function oriented interface is not faster than t
+he OO version).

In order for me to determine the file object, I took a short cut and u
+sed the
C<CGI::self_or_default> method to capture that object.  This simplifie
+s my code, but
it's possible that some versions of CGI.pm do not use this.  If that i
+s the case, I
will need to pull the appropriate methods from the callers namespace (
+maybe) to get
access to the uploaded file.

=cut
Replies are listed 'Best First'.
Re: CGI::Safe and easy file uploading
by $code or die (Deacon) on Aug 14, 2001 at 19:35 UTC
    ++ Ovid.

    This is the code that I usually run whenever I install perl on a new machine or update CGI.pm (I like to have my cake and eat it.)
    use CGI; use strict; { my %CGI_Patch; local ($^I, @ARGV) = ('.bak', $INC{'CGI.pm'}); while (<>) { s/^(\s*\$POST_MAX\s*=\s*)([^;]*);/${1}1024 * 100;/ && $CGI_Patch{POSTMAX}++; s/^(\s*\$DISABLE_UPLOADS\s*=\s*)([^;]*);/${1}1;/ && $CGI_Patch{NOUPLOADS}++; # I'll have my cake and eat it too!... my $cake = '\$query_string .= \(length\(\$query_string\) +'. '\? \'&\' : \'\'\) . \$ENV{\'QUERY_STRING\'}'. ' if defined \$ENV{\'QUERY_STRING\'};'; s/(\s*)#(\s*)($cake)/$1$2$3/ && $CGI_Patch{CAKE}++; print; close ARGV if eof; } print "CGI.pm ($INC{'CGI.pm'}) patch results...\n"; print '$POSTMAX updated...........' , $CGI_Patch{POSTMAX} , "\n"; print '$DISABLE_UPLOADS updated...' , $CGI_Patch{NOUPLOADS} , "\n" +; print 'Have your cake and eat it..' , $CGI_Patch{CAKE} , "\n"; }
    Admittedly, this code is likely to break when CGI changes dramatically, so it's not as robust as CGI::Safe. I like to edit the source, so I make sure that everyone else's code on the server is a bit more secure.

    Error: Keyboard not attached. Press F1 to continue.
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://104626]
help
Chatterbox?
LanX hates UTF8 for causing knots in his brain and stomach
[Corion]: LanX: Yes, that's the main problem - you have lots (and lots) of workarounds in various places and stages of the processing, and to clean that mess up requires action across the complete codebase. And it's almost impossible to do it piece-by-piece

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (11)
As of 2017-01-16 14:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you watch meteor showers?




    Results (150 votes). Check out past polls.