################################
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 Environment
    $CGI::DISABLE_UPLOADS = 1;                    # Disable uploads
    $CGI::POST_MAX        = 512 * 1024;           # limit posts to 512K 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 fashion
    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 the 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 object';
    }
    
    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 various 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_UPLOADS.  This may be why no file was uploaded."
        }
        return \%data;
    }

    $data{ format } = $specs{ cgi }->uploadInfo( $fh )->{ 'Content-Type' };
    if ( exists $specs{ format } ) {
        my @format = ref $specs{ format } eq 'ARRAY' ? @{ $specs{ format } } 
                                                     :    $specs{ format } ;
        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 }.  Expecting: $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-line 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 that it allows 
uploads by default and does not have a maximum post size. Since it saves 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 include 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 before 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 these lines of code. 
Some suggest changing these settings directly in CGI.pm. I dislike this 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 good thing depending 
upon the security implications). 

Hence, the C<CGI::Safe> module.  It will establish the defaults for those variables and 
require virtually no code changes.  Additionally, it will delete C<%ENV> 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 fashion.

 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 have 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 necessary, the programmer can
override these values two different ways.  When using the function oriented interface, if needing
file uploads and wanting to allow up to a 1 megabyte upload, they would set these values directly
I<before> using C<CGI::Safe::get_upload> or using any of the CGI.pm CGI 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 them 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 formatted query string passed
directly to the object, or even a has with name value pairs representing the query string.  To
use this functionality with the C<CGI::Safe> module, pass this extra information 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 included as many, many programmers
have difficulty with this.  C<CGI::Safe::get_upload> has takes three named 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 type or a list reference with multiple
allowed file types.  If the uploaded file doesn't match one of the supplied types, will return an error.
By leaving this parameter off, C<CGI::Safe::get_upload> will return any type of file.

=item 3 I<cgi>

If, for some reason, you are using multiple CGI objects, you can specify the CGI object which has the file
in question.  This parameter is also optional.  It should seldom, if ever, 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 you have another cgi object instantiated
                                                 # and it has the upload data that you need

=head2 Return value from uploading

C<CGI::Safe::get_upload> returns a scalar with a reference to an anonymous 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 GIF 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 it 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 version 
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 somewhat concerned
about the use of this module with the function oriented interface.  CGI.pm uses
objects internally, even when using the function oriented interface (which is part
of the reason why the function oriented interface is not faster than the OO version).

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

=cut