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) = ($_ =~ /^(.*)$/s);  # 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(t/lib lib);
  27
  28 use Test::More;
  29 use Test::Exception;
  30 use DBICTest;
  31
  32 throws_ok (
  33   sub { $ENV{PATH} . (kill (0)) },
  34   qr/Insecure dependency in kill/,
  35   'taint mode active'
  36 );
  37
  38 {
  39   package DBICTest::Taint::Classes;
  40
  41   use Test::More;
  42   use Test::Exception;
  43
  44   use base qw/DBIx::Class::Schema/;
  45
  46   lives_ok (sub {
  47     __PACKAGE__->load_classes(qw/Manual/);
  48     ok( __PACKAGE__->source('Manual'), 'The Classes::Manual source has been registered' );
  49     __PACKAGE__->_unregister_source (qw/Manual/);
  50   }, 'Loading classes with explicit load_classes worked in taint mode' );
  51
  52   lives_ok (sub {
  53     __PACKAGE__->load_classes();
  54     ok( __PACKAGE__->source('Auto'), 'The Classes::Auto source has been registered' );
  55       ok( __PACKAGE__->source('Auto'), 'The Classes::Manual source has been re-registered' );
  56   }, 'Loading classes with Module::Find/load_classes worked in taint mode' );
  57 }
  58
  59 {
  60   package DBICTest::Taint::Namespaces;
  61
  62   use Test::More;
  63   use Test::Exception;
  64
  65   use base qw/DBIx::Class::Schema/;
  66
  67   lives_ok (sub {
  68     __PACKAGE__->load_namespaces();
  69     ok( __PACKAGE__->source('Test'), 'The Namespaces::Test source has been registered' );
  70   }, 'Loading classes with Module::Find/load_namespaces worked in taint mode' );
  71 }
  72
  73 done_testing;