diff --git a/MANIFEST b/MANIFEST index 2047b00..1628fe4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -30,3 +30,5 @@ t/win32.t xt/author-critic.t xt/author-pod-coverage.t xt/author-pod-syntax.t +t/07_taint.pl +t/10_formatting.pl diff --git a/t/07_taint.pl b/t/07_taint.pl new file mode 100644 index 0000000..6b0f7c8 --- /dev/null +++ b/t/07_taint.pl @@ -0,0 +1,57 @@ +#!/usr/bin/perl -w +use strict; +use Test::More tests => 13; +use Scalar::Util qw(tainted); +use Config; + +my $perl_path = $Config{perlpath}; + +if ($^O ne 'VMS') { + $perl_path .= $Config{_exe} + unless $perl_path =~ m/$Config{_exe}$/i; +} + +ok(! tainted($perl_path), '$perl_path is clean'); + +use_ok("IPC::System::Simple","run","capture"); + +chdir("t"); # Ignore return, since we may already be in t/ + +my $taint = $0 . "foo"; # ."foo" to avoid zero length +ok(tainted($taint),"Sanity - executable name is tainted"); + +my $evil_zero = 1 - (length($taint) / length($taint)); + +ok(tainted($evil_zero),"Sanity - Evil zero is tainted"); +is($evil_zero,"0","Sanity - Evil zero is still zero"); + +SKIP: { + skip('$ENV{PATH} is clean',2) unless tainted $ENV{PATH}; + + eval { run("$perl_path exiter.pl 0"); }; + like($@,qr{called with tainted environment},"Single-arg, tainted ENV"); + + eval { run($perl_path, "exiter.pl", 0); }; + like($@,qr{called with tainted environment},"Multi-arg, tainted ENV"); +} + +delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV PERL5SHELL DCL$PATH)}; + +eval { run("$perl_path exiter.pl $evil_zero"); }; +like($@,qr{called with tainted argument},"Single-arg, tainted data"); + +eval { run($perl_path, "exiter.pl", $evil_zero); }; +like($@,qr{called with tainted argument},"multi-arg, tainted data"); + +eval { run("$perl_path exiter.pl 0"); }; +is($@, "", "Single-arg, clean data and ENV"); + +eval { run($perl_path, "exiter.pl", 0); }; +is($@, "", "Multi-arg, clean data and ENV"); + +my $data = eval { capture($perl_path, "exiter.pl", 0) }; +ok(tainted($data), "Returns of multi-arg capture should be tainted"); + +$data = eval { capture("$perl_path exiter.pl 0") }; +ok(tainted($data), "Returns of single-arg capture should be tainted"); + diff --git a/t/07_taint.t b/t/07_taint.t index b16ef8e..c70527a 100644 --- a/t/07_taint.t +++ b/t/07_taint.t @@ -1,57 +1,12 @@ -#!/usr/bin/perl -wT use strict; -use Test::More tests => 13; -use Scalar::Util qw(tainted); +use Test::More; use Config; - -my $perl_path = $Config{perlpath}; - -if ($^O ne 'VMS') { - $perl_path .= $Config{_exe} - unless $perl_path =~ m/$Config{_exe}$/i; +if(!$Config{taint_disabled}) { + exec( + $^X, '-T', + (map { "-I$_" } @INC), + 't/07_taint.pl' + ); +} else { + plan skip_all => 'Test not relevant on a perl built without taint support'; } - -ok(! tainted($perl_path), '$perl_path is clean'); - -use_ok("IPC::System::Simple","run","capture"); - -chdir("t"); # Ignore return, since we may already be in t/ - -my $taint = $0 . "foo"; # ."foo" to avoid zero length -ok(tainted($taint),"Sanity - executable name is tainted"); - -my $evil_zero = 1 - (length($taint) / length($taint)); - -ok(tainted($evil_zero),"Sanity - Evil zero is tainted"); -is($evil_zero,"0","Sanity - Evil zero is still zero"); - -SKIP: { - skip('$ENV{PATH} is clean',2) unless tainted $ENV{PATH}; - - eval { run("$perl_path exiter.pl 0"); }; - like($@,qr{called with tainted environment},"Single-arg, tainted ENV"); - - eval { run($perl_path, "exiter.pl", 0); }; - like($@,qr{called with tainted environment},"Multi-arg, tainted ENV"); -} - -delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV PERL5SHELL DCL$PATH)}; - -eval { run("$perl_path exiter.pl $evil_zero"); }; -like($@,qr{called with tainted argument},"Single-arg, tainted data"); - -eval { run($perl_path, "exiter.pl", $evil_zero); }; -like($@,qr{called with tainted argument},"multi-arg, tainted data"); - -eval { run("$perl_path exiter.pl 0"); }; -is($@, "", "Single-arg, clean data and ENV"); - -eval { run($perl_path, "exiter.pl", 0); }; -is($@, "", "Multi-arg, clean data and ENV"); - -my $data = eval { capture($perl_path, "exiter.pl", 0) }; -ok(tainted($data), "Returns of multi-arg capture should be tainted"); - -$data = eval { capture("$perl_path exiter.pl 0") }; -ok(tainted($data), "Returns of single-arg capture should be tainted"); - diff --git a/t/10_formatting.pl b/t/10_formatting.pl new file mode 100644 index 0000000..a4a16fd --- /dev/null +++ b/t/10_formatting.pl @@ -0,0 +1,39 @@ +#!/usr/bin/perl -w +use strict; +use Test::More tests => 5; + +use_ok("IPC::System::Simple","run"); + +# A formatting bug caused ISS to mention its name twice in +# diagnostics. These tests make sure it's fixed. + + +eval { + run($^X); +}; + +like($@,qr{^IPC::System::Simple::run called with tainted argument},"Taint pkg only once"); + +eval { + run(1); +}; + +like($@,qr{^IPC::System::Simple::run called with tainted environment},"Taint env only once"); + +# Delete everything in %ENV so we can't get taint errors. + +my @keys = keys %ENV; + +delete $ENV{$_} foreach @keys; + +eval { + run(); +}; + +like($@,qr{^IPC::System::Simple::run called with no arguments},"Package mentioned only once"); + +eval { + run([0]); +}; + +like($@,qr{^IPC::System::Simple::run called with no command},"Package mentioned only once"); diff --git a/t/10_formatting.t b/t/10_formatting.t index 6887f89..a148e7a 100644 --- a/t/10_formatting.t +++ b/t/10_formatting.t @@ -1,39 +1,12 @@ -#!/usr/bin/perl -wT use strict; -use Test::More tests => 5; - -use_ok("IPC::System::Simple","run"); - -# A formatting bug caused ISS to mention its name twice in -# diagnostics. These tests make sure it's fixed. - - -eval { - run($^X); -}; - -like($@,qr{^IPC::System::Simple::run called with tainted argument},"Taint pkg only once"); - -eval { - run(1); -}; - -like($@,qr{^IPC::System::Simple::run called with tainted environment},"Taint env only once"); - -# Delete everything in %ENV so we can't get taint errors. - -my @keys = keys %ENV; - -delete $ENV{$_} foreach @keys; - -eval { - run(); -}; - -like($@,qr{^IPC::System::Simple::run called with no arguments},"Package mentioned only once"); - -eval { - run([0]); -}; - -like($@,qr{^IPC::System::Simple::run called with no command},"Package mentioned only once"); +use Test::More; +use Config; +if(!$Config{taint_disabled}) { + exec( + $^X, '-T', + (map { "-I$_" } @INC), + 't/10_formatting.pl' + ); +} else { + plan skip_all => 'Test not relevant on a perl built without taint support'; +}