Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
Just another Perl shrine
 
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

Comment on CGI::Safe and easy file uploading
Download Code
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.

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (9)
As of 2014-04-23 23:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (557 votes), past polls