Skip to content

Commit

Permalink
Make sure everything still runs under taint mode
Browse files Browse the repository at this point in the history
  • Loading branch information
ribasushi committed Feb 7, 2014
1 parent 313d724 commit d33e73e
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 3 deletions.
7 changes: 6 additions & 1 deletion lib/Test/DiagINC.pm
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,12 @@ sub _max_length {
# Get our CWD *without* loading anything. Original idea by xdg++
# ribasushi thinks this is fragile and will break sooner rather than
# later, but adding it as is because haarg and xdg both claim it's fine
my $REALPATH_CWD = `$^X -MCwd -e print+getcwd`;
my $REALPATH_CWD = do {
local $ENV{PATH};
my ($perl) = $^X =~ /(.+)/; # $^X is internal how could it be tainted?!
`$perl -MCwd -e print+getcwd`;
};

my $ORIGINAL_PID = $$;

END {
Expand Down
16 changes: 14 additions & 2 deletions t/basic.t
Original file line number Diff line number Diff line change
Expand Up @@ -8,10 +8,22 @@ push @testfiles, 'fails_in_end.t' unless $] < 5.008;

plan tests => @testfiles * ($] < 5.010 ? 3 : 4);

my $tainted_run = ! eval { $ENV{PATH} . kill(0) and 1 }
and diag ( __FILE__ . ' running under taint mode' );

local $ENV{AUTOMATED_TESTING} = 1;

# untaint PATH but do not unset it so we test that $^X will
# run with it just fine
local ( $ENV{PATH} ) = $ENV{PATH} =~ /(.*)/ if $tainted_run;

for my $file (@testfiles) {
$ENV{AUTOMATED_TESTING} = 1;
my ( $stdout, $stderr ) = capture {
system( $^X, "examples/$file" );
system(
($^X =~ /(.+)/), # $^X is internal how can it be tainted?!
( $tainted_run ? (qw( -I . -I lib -T )) : () ),
"examples/$file"
);
};

like( $stderr, qr/\QListing modules from %INC/, "$file: Saw diagnostic header" );
Expand Down
17 changes: 17 additions & 0 deletions t/taint.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
use warnings;
use strict;
use File::Spec;

# there is talk of possible perl compilations where -T is a fatal
# we don't want to have the user deal with that
system( $^X => -T => -e => 'use warnings; use strict; exit 0' );
if ($?) {
print "1..0 # SKIP Your perl does not seem to like -T...\n";
exit 0;
}

# all is well - just rerun the basic test
exec( $^X => -T => File::Spec->catpath(
(File::Spec->splitpath( __FILE__ ))[0,1],
'basic.t'
) );

0 comments on commit d33e73e

Please sign in to comment.