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. Use lib.pm instead of an @INC unshift as
  12 # it will correctly add any arch subdirs encountered
  13 use Config;
  14
  15 use lib (
  16   grep { length }
  17     map { split /\Q$Config{path_sep}\E/, (/^(.*)$/)[0] }  # untainting regex
  18       grep { defined }
  19         @ENV{qw(PERL5LIB PERLLIB)}  # precedence preserved by lib
  20 );
  21
  22 # We need to specify 'lib' here as well because even if it was already in
  23 # @INC, the above will have put our local::lib in front of it, so now an
  24 # installed DBIx::Class will take precedence over the one we're trying to test.
  25 # In some cases, prove will have supplied ./lib as an absolute path so it
  26 # doesn't seem worth trying to remove the second copy since it won't hurt
  27 # anything.
  28 use lib qw(t/lib lib);
  29
  30 use Test::More;
  31 use Test::Exception;
  32 use DBICTest;
  33
  34 throws_ok (
  35   sub { $ENV{PATH} . (kill (0)) },
  36   qr/Insecure dependency in kill/,
  37   'taint mode active'
  38 );
  39
  40 {
  41   package DBICTest::Taint::Classes;
  42
  43   use Test::More;
  44   use Test::Exception;
  45
  46   use base qw/DBIx::Class::Schema/;
  47
  48   lives_ok (sub {
  49     __PACKAGE__->load_classes(qw/Manual/);
  50     ok( __PACKAGE__->source('Manual'), 'The Classes::Manual source has been registered' );
  51     __PACKAGE__->_unregister_source (qw/Manual/);
  52   }, 'Loading classes with explicit load_classes worked in taint mode' );
  53
  54   lives_ok (sub {
  55     __PACKAGE__->load_classes();
  56     ok( __PACKAGE__->source('Auto'), 'The Classes::Auto source has been registered' );
  57       ok( __PACKAGE__->source('Auto'), 'The Classes::Manual source has been re-registered' );
  58   }, 'Loading classes with Module::Find/load_classes worked in taint mode' );
  59 }
  60
  61 {
  62   package DBICTest::Taint::Namespaces;
  63
  64   use Test::More;
  65   use Test::Exception;
  66
  67   use base qw/DBIx::Class::Schema/;
  68
  69   lives_ok (sub {
  70     __PACKAGE__->load_namespaces();
  71     ok( __PACKAGE__->source('Test'), 'The Namespaces::Test source has been registered' );
  72   }, 'Loading classes with Module::Find/load_namespaces worked in taint mode' );
  73 }
  74
  75 done_testing;