File Coverage

blib/lib/Taint/Runtime.pm

Criterion	Covered	Total	%
statement	42	68	61.7
branch	23	40	57.5
condition	3	8	37.5
subroutine	14	18	77.7
pod	9	10	90.0
total	91	144	63.1

package Taint::Runtime;

=head1 NAME

Taint::Runtime - Runtime enable taint checking

=cut

use strict;
use Exporter;
use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION $TAINT);
use XSLoader;

@ISA = qw(Exporter);
%EXPORT_TAGS = (
                'all' => [qw(
                             taint_start
                             taint_stop
                             taint_enabled
                             tainted
                             is_tainted
                             taint
                             untaint
                             taint_env
                             taint_deeply
                             $TAINT
                             ) ],
                );
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw(taint_start taint_stop);

$VERSION = '0.03';
XSLoader::load('Taint::Runtime', $VERSION);

###----------------------------------------------------------------###

tie $TAINT, __PACKAGE__;

sub TIESCALAR {
  return bless [], __PACKAGE__;
}

sub FETCH {
  _taint_enabled() ? 1 : 0;
}

sub STORE {
  my ($self, $val) = @_;
  $val = 0 if ! $val || $val eq 'disable';
  $val ? _taint_start() : _taint_stop();
}

###----------------------------------------------------------------###

### allow for special enable/disable keywords
sub import {
  my $change;
  for my $i (reverse 1 .. $#_) {
    next if $_[$i] !~ /^(dis|en)able$/;
    my $val = $1 eq 'dis' ? 0 : 1;
    splice @_, $i, 1, ();
    die 'Cannot both enable and disable $TAINT during import' if defined $change && $change != $val;
    $TAINT = $val;
  }
  __PACKAGE__->export_to_level(1, @_);
}

###----------------------------------------------------------------###

sub taint_start { _taint_start(); }

sub taint_stop  { _taint_stop() }

sub taint_enabled { _taint_enabled() }

sub tainted { _tainted() }

sub is_tainted { return if ! defined $_[0]; ! eval { eval '#'.substr($_[0], 0, 0); 1 } }

# slower on tainted and undef
# modified version from standard lib/perl/5.8.5/tainted.pl
sub is_tainted2 { local $^W = 0; local $@; eval { kill 0 * $_[0] }; $@ =~ /^Insecure/ }

sub taint {
  my $str = shift;
  my $ref = ref($str) ? $str : \$str;
  $$ref = '' if ! defined $$ref;
  $$ref .= tainted();
  return ref($str) ? 1 : $str;
}

sub untaint {
  my $str = shift;
  my $ref = ref($str) ? $str : \$str;
  if (! defined $$ref) {
    $$ref = undef;
  } else {
    $$ref = ($$ref =~ /(.*)/s) ? $1 : do { require Carp; Carp::confess("Couldn't find data to untaint") };
  }
  return ref($str) ? 1 : $str;
}

###----------------------------------------------------------------###

sub taint_env {
  taint_deeply(\%ENV);
}

sub taint_deeply {
  my ($ref, $seen) = @_;

  return if ! defined $ref; # can undefined be tainted ?

  if (! ref $ref) {
    taint \$_[0]; # better be modifyable
    return;

  } elsif (UNIVERSAL::isa($ref, 'SCALAR')) {
    taint $ref;
    return;
  }

  ### avoid circular descent
  $seen ||= {};
  return if $seen->{$ref};
  $seen->{$ref} = 1;

  if (UNIVERSAL::isa($ref, 'ARRAY')) {
    taint_deeply($_, $seen) foreach @$ref;

  } elsif (UNIVERSAL::isa($ref, 'HASH')) {
    while (my ($key, $val) = each %$ref) {
      taint_deeply($key);
      taint_deeply($val, $seen);
      $ref->{$key} = $val;
    }
  } else {
    # not really sure if or what to do for GLOBS or CODE refs
  }
}

###----------------------------------------------------------------###

1;

__END__