t/54taint.t

   1 #!/usr/bin/env perl -T
   2
   3 # the above line forces Test::Harness into taint-mode
   4 # DO NOT REMOVE
   5
   6 use strict;
   7 use warnings;
   8
   9 # When in taint mode, PERL5LIB is ignored (but *not* unset)
  10 # Put it back in INC so that local-lib users can actually
  11 # run this test
  12 use Config;
  13 BEGIN {
  14   for (map { defined $ENV{$_} ? $ENV{$_} : () } (qw/PERLLIB PERL5LIB/) ) {  # we unshift, so reverse precedence
  15     my ($envvar) = ($_ =~ /^(.+)$/);  # untaint
  16     unshift @INC, map { length($_) ? $_ : () } (split /\Q$Config{path_sep}\E/, $envvar);
  17   }
  18 }
  19
  20 # We need to specify 'lib' here as well because even if it was already in
  21 # @INC, the above will have put our local::lib in front of it, so now an
  22 # installed DBIx::Class will take precedence over the one we're trying to test.
  23 # In some cases, prove will have supplied ./lib as an absolute path so it
  24 # doesn't seem worth trying to remove the second copy since it won't hurt
  25 # anything.
  26 use lib qw(lib);
  27 use lib qw(t/lib);
  28
  29 use Test::More;
  30 use Test::Exception;
  31 use DBICTest;
  32
  33 throws_ok (
  34   sub { $ENV{PATH} . (kill (0)) },
  35   qr/Insecure dependency in kill/,
  36   'taint mode active'
  37 );
  38
  39 {
  40   package DBICTest::Taint::Classes;
  41
  42   use Test::More;
  43   use Test::Exception;
  44
  45   use base qw/DBIx::Class::Schema/;
  46
  47   lives_ok (sub {
  48     __PACKAGE__->load_classes(qw/Manual/);
  49     ok( __PACKAGE__->source('Manual'), 'The Classes::Manual source has been registered' );
  50     __PACKAGE__->_unregister_source (qw/Manual/);
  51   }, 'Loading classes with explicit load_classes worked in taint mode' );
  52
  53   lives_ok (sub {
  54     __PACKAGE__->load_classes();
  55     ok( __PACKAGE__->source('Auto'), 'The Classes::Auto source has been registered' );
  56       ok( __PACKAGE__->source('Auto'), 'The Classes::Manual source has been re-registered' );
  57   }, 'Loading classes with Module::Find/load_classes worked in taint mode' );
  58 }
  59
  60 {
  61   package DBICTest::Taint::Namespaces;
  62
  63   use Test::More;
  64   use Test::Exception;
  65
  66   use base qw/DBIx::Class::Schema/;
  67
  68   lives_ok (sub {
  69     __PACKAGE__->load_namespaces();
  70     ok( __PACKAGE__->source('Test'), 'The Namespaces::Test source has been registered' );
  71   }, 'Loading classes with Module::Find/load_namespaces worked in taint mode' );
  72 }
  73
  74 done_testing;