File Coverage

blib/lib/CGI/Safe.pm

Criterion	Covered	Total	%
statement	61	63	96.8
branch	16	24	66.6
condition	6	9	66.6
subroutine	11	13	84.6
pod	4	4	100.0
total	98	113	86.7

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

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

use vars qw/ $shell $path /;

BEGIN {

    # Clean up the environment and establish some defaults
    $shell = $ENV{'SHELL'};
    $path  = $ENV{'PATH'};
    delete @ENV{qw/ IFS CDPATH ENV BASH_ENV PATH SHELL /};
    $CGI::DISABLE_UPLOADS = 1;             # Disable uploads
    $CGI::POST_MAX        = 512 * 1024;    # limit posts to 512K max
}

sub import {
    if ( grep { /:(?:standard|cgi)/ } @_ ) {
        my $set_sub   = caller(0) . '::set';
        my $shell_sub = caller(0) . '::get_shell';
        my $path_sub  = caller(0) . '::get_path';
        {
            no strict 'refs';
            *{$set_sub}   = \&set;
            *{$shell_sub} = \&get_shell;
            *{$path_sub}  = \&get_path;
        }
    }

    my $index;

    # restore untainted path and shell if the list 'admin' in import list
    my %args = map { $_ => 1 } @_[ 1 .. $#_ ];

    if ( exists $args{'admin'} ) {

    # If 'admin' is specified, we'll reset the PATH and SHELL.  These will still
    # be tainted and require untainting by the CGI program.
        $ENV{'PATH'}  = $path  if defined $path;
        $ENV{'SHELL'} = $shell if defined $shell;
        delete $args{'admin'};
        splice @_, 1, $#_, keys %args;
    }

    # TODO: Future releases will allow untainting to occur at the time that CGI
    # data is grabbed.  We include this so that people will know that future
    # versions will require 'taint' in the import list to allow their scripts to
    # run with minimal changes
    if ( exists $args{'taint'} ) {
        delete $args{'taint'};
        splice @_, 1, $#_, keys %args;
    }

    # using goto to avoid updating caller
    goto &CGI::import;
}

sub new {
    my ( $class, %args ) = @_;
    $CGI::DISABLE_UPLOADS = $args{'DISABLE_UPLOADS'}
      if exists $args{'DISABLE_UPLOADS'};
    $CGI::POST_MAX = $args{'POST_MAX'} if exists $args{'POST_MAX'};
    $ENV{'PATH'}   = $args{'PATH'}     if exists $args{'PATH'};
    $ENV{'SHELL'}  = $args{'SHELL'}    if exists $args{'SHELL'};

    return CGI::new( $class,
        ( exists $args{'source'} ? $args{'source'} : () ) );
}

sub set {
    my ( $self, %args ) = CGI::self_or_default(@_);
    if ( exists $args{'DISABLE_UPLOADS'}
        and defined $args{'DISABLE_UPLOADS'} )
    {
        $CGI::DISABLE_UPLOADS = $args{'DISABLE_UPLOADS'};
    }
    if (    exists $args{'POST_MAX'}
        and defined $args{'POST_MAX'}
        and $args{'POST_MAX'} =~ /^\d+$/ )
    {
        $CGI::POST_MAX = $args{'POST_MAX'};
    }
}

sub get_path { $path }

sub get_shell { $shell }

"Ovid";

__END__