Commit | Line | Data |
f54428ab |
1 | #!/usr/bin/env perl -T |
83542a7d |
2 | |
3 | # the above line forces Test::Harness into taint-mode |
f54428ab |
4 | # DO NOT REMOVE |
83542a7d |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9f72d93a |
9 | # When in taint mode, PERL5LIB is ignored (but *not* unset) |
10 | # Put it back in INC so that local-lib users can actually |
a8de639b |
11 | # run this test. Use lib.pm instead of an @INC unshift as |
12 | # it will correctly add any arch subdirs encountered |
9f72d93a |
13 | use Config; |
a8de639b |
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 | ); |
9f72d93a |
21 | |
6fc6d60c |
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 | |
91b0ad0b |
30 | use Test::More; |
f54428ab |
31 | use Test::Exception; |
8d6b1478 |
32 | use DBICTest; |
83542a7d |
33 | |
f54428ab |
34 | throws_ok ( |
35 | sub { $ENV{PATH} . (kill (0)) }, |
36 | qr/Insecure dependency in kill/, |
37 | 'taint mode active' |
38 | ); |
83542a7d |
39 | |
f54428ab |
40 | { |
41 | package DBICTest::Taint::Classes; |
83542a7d |
42 | |
f54428ab |
43 | use Test::More; |
44 | use Test::Exception; |
91b0ad0b |
45 | |
f54428ab |
46 | use base qw/DBIx::Class::Schema/; |
91b0ad0b |
47 | |
f54428ab |
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' ); |
91b0ad0b |
53 | |
f54428ab |
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 | } |
83542a7d |
60 | |
f54428ab |
61 | { |
62 | package DBICTest::Taint::Namespaces; |
83542a7d |
63 | |
f54428ab |
64 | use Test::More; |
65 | use Test::Exception; |
91b0ad0b |
66 | |
f54428ab |
67 | use base qw/DBIx::Class::Schema/; |
83542a7d |
68 | |
f54428ab |
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 | } |
91b0ad0b |
74 | |
f2d11f4a |
75 | # check that we can create a database and all |
76 | { |
77 | my $s = DBICTest->init_schema( sqlite_use_file => 1 ); |
78 | my $art = $s->resultset('Artist')->search({}, { |
79 | prefetch => 'cds', order_by => 'artistid', |
80 | })->next; |
81 | is ($art->artistid, 1, 'got artist'); |
82 | } |
83 | |
f54428ab |
84 | done_testing; |