X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F54taint.t;h=573e3c0592dcf1fbdfb95633d3f9fb8e7a56e5a0;hb=da89304fa29f8fd18d235d120ccbea7d2cfbecdf;hp=8e93b48083f6bcfe5b3df826398b70cd2dcea22a;hpb=83542a7dc6aa41ab9c46572f78f62bc68cc50146;p=dbsrgits%2FDBIx-Class.git diff --git a/t/54taint.t b/t/54taint.t index 8e93b48..573e3c0 100644 --- a/t/54taint.t +++ b/t/54taint.t @@ -1,33 +1,66 @@ -#!perl -T +#!/usr/bin/env perl -T # the above line forces Test::Harness into taint-mode +# DO NOT REMOVE use strict; use warnings; -our @plan; - +# When in taint mode, PERL5LIB is ignored (but *not* unset) +# Put it back in INC so that local-lib users can actually +# run this test +use Config; BEGIN { - eval "require Module::Find;"; - @plan = $@ ? ( skip_all => 'Could not load Module::Find' ) - : ( tests => 2 ); + for (map { defined $ENV{$_} ? $ENV{$_} : () } (qw/PERLLIB PERL5LIB/) ) { # we unshift, so reverse precedence + my ($envvar) = ($_ =~ /^(.+)$/); # untaint + unshift @INC, map { length($_) ? $_ : () } (split /\Q$Config{path_sep}\E/, $envvar); + } } -package DBICTest::Schema; +use Test::More; +use Test::Exception; +use lib qw(t/lib); +use DBICTest; -# Use the default test class namespace to avoid the need for a -# new test infrastructure. If invalid classes will be introduced to -# 't/lib/DBICTest/Schema/' someday, this has to be reworked. +throws_ok ( + sub { $ENV{PATH} . (kill (0)) }, + qr/Insecure dependency in kill/, + 'taint mode active' +); -use lib qw(t/lib); +{ + package DBICTest::Taint::Classes; + + use Test::More; + use Test::Exception; + + use base qw/DBIx::Class::Schema/; -use Test::More @plan; + lives_ok (sub { + __PACKAGE__->load_classes(qw/Manual/); + ok( __PACKAGE__->source('Manual'), 'The Classes::Manual source has been registered' ); + __PACKAGE__->_unregister_source (qw/Manual/); + }, 'Loading classes with explicit load_classes worked in taint mode' ); -use base qw/DBIx::Class::Schema/; + lives_ok (sub { + __PACKAGE__->load_classes(); + ok( __PACKAGE__->source('Auto'), 'The Classes::Auto source has been registered' ); + ok( __PACKAGE__->source('Auto'), 'The Classes::Manual source has been re-registered' ); + }, 'Loading classes with Module::Find/load_classes worked in taint mode' ); +} + +{ + package DBICTest::Taint::Namespaces; + + use Test::More; + use Test::Exception; -eval{ __PACKAGE__->load_classes() }; -cmp_ok( $@, 'eq', '', - 'Loading classes with Module::Find worked in taint mode' ); -ok( __PACKAGE__->sources(), 'At least on source has been registered' ); + use base qw/DBIx::Class::Schema/; + + lives_ok (sub { + __PACKAGE__->load_namespaces(); + ok( __PACKAGE__->source('Test'), 'The Namespaces::Test source has been registered' ); + }, 'Loading classes with Module::Find/load_namespaces worked in taint mode' ); +} -1; +done_testing;