################################
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