use Config;
use File::Spec::Functions;
+my $total_tests = 236;
my $test = 177;
sub ok ($;$) {
my($ok, $name) = @_;
eval { require IPC::SysV };
unless ($@) {
$ipcsysv++;
- IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU));
+ IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU IPC_NOWAIT));
}
}
}
my $TEST = catfile(curdir(), 'TEST');
-print "1..203\n";
+print "1..$total_tests\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
if ($Is_Cygwin && ! -f 'cygwin1.dll') {
system("/usr/bin/cp /usr/bin/cygwin1.dll .") &&
die "$0: failed to cp cygwin1.dll: $!\n";
- END { unlink "cygwin1.dll" } # yes, done for all platforms...
+ eval q{
+ END { unlink "cygwin1.dll" }
+ };
+ }
+
+ if ($Is_Cygwin && ! -f 'cygcrypt-0.dll' && -f '/usr/bin/cygcrypt-0.dll') {
+ system("/usr/bin/cp /usr/bin/cygcrypt-0.dll .") &&
+ die "$0: failed to cp cygcrypt-0.dll: $!\n";
+ eval q{
+ END { unlink "cygcrypt-0.dll" }
+ };
}
test 1, eval { `$echo 1` } eq "1\n";
test 87, $@ eq '', $@;
}
else {
- for (86..87) { print "ok $_ # Skipped: this is not VMS\n"; }
+ for (86..87) { print "ok $_ # Skipped: This is not VMS\n"; }
}
}
my $type_rcvd;
if (defined $id) {
- if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
- if (msgrcv($id, $rcvd, 60, 0, 0)) {
+ if (msgsnd($id, pack("l! a*", $type_sent, $sent), IPC_NOWAIT)) {
+ if (msgrcv($id, $rcvd, 60, 0, IPC_NOWAIT)) {
($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
} else {
- warn "# msgrcv failed\n";
+ warn "# msgrcv failed: $!\n";
}
} else {
- warn "# msgsnd failed\n";
+ warn "# msgsnd failed: $!\n";
}
msgctl($id, IPC_RMID, 0) or warn "# msgctl failed: $!\n";
} else {
my @untainted;
while (my ($k, $v) = each %ENV) {
if (!tainted($v) &&
- # These we have untainted explicitly earlier.
- $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|TEMP|TERM|TMP)$/) {
+ # These we have explicitly untainted or set earlier.
+ $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|PERL_CORE|TEMP|TERM|TMP)$/) {
push @untainted, "# '$k' = '$v'\n";
}
}
}
-ok( ${^TAINT}, '$^TAINT is on' );
+ok( ${^TAINT} == 1, '$^TAINT is on' );
eval { ${^TAINT} = 0 };
ok( ${^TAINT}, '$^TAINT is not assignable' );
test 183, $@ =~ /^Insecure \$ENV/;
}
if ($Is_VMS) {
- for (184..203) {print "not ok $_ # TODO tainted %ENV warning occludes tainted arguments warning\n";}
+ for (184..205) {print "not ok $_ # TODO tainted %ENV warning occludes tainted arguments warning\n";}
}
else
{
# bug 20020208.005 plus some extras
# single arg exec/system are tests 80-83
- use if $] lt '5.009', warnings => FATAL => 'taint';
- my $err = $] ge '5.009' ? qr/^Insecure dependency/
- : qr/^Use of tainted arguments/;
+ my $err = qr/^Insecure dependency/ ;
test 184, eval { exec $TAINT, $TAINT } eq '', 'exec';
test 185, $@ =~ $err, $@;
test 186, eval { exec $TAINT $TAINT } eq '', 'exec';
test 194, eval { system $TAINT, $TAINT } eq '', 'system';
test 195, $@ =~ $err, $@;
- test 196, eval { system $TAINT $TAINT } eq '', 'exec';
+ test 196, eval { system $TAINT $TAINT } eq '', 'system';
test 197, $@ =~ $err, $@;
- test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'exec';
+ test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'system';
test 199, $@ =~ $err, $@;
- test 200, eval { system $TAINT 'notaint' } eq '', 'exec';
+ test 200, eval { system $TAINT 'notaint' } eq '', 'system';
test 201, $@ =~ $err, $@;
- test 202, eval { system {'notaint'} $TAINT } eq '', 'exec';
+ test 202, eval { system {'notaint'} $TAINT } eq '', 'system';
test 203, $@ =~ $err, $@;
+
+ eval { system("lskdfj does not exist","with","args"); };
+ test 204, $@ eq '';
+ if ($Is_MacOS) {
+ print "ok 205 # no exec()\n";
+ } else {
+ eval { exec("lskdfj does not exist","with","args"); };
+ test 205, $@ eq '';
+ }
+
+ # If you add tests here update also the above skip block for VMS.
+}
+
+{
+ # [ID 20020704.001] taint propagation failure
+ use re 'taint';
+ $TAINT =~ /(.*)/;
+ test 206, tainted(my $foo = $1);
+}
+
+{
+ # [perl #24291] this used to dump core
+ our %nonmagicalenv = ( PATH => "util" );
+ local *ENV = \%nonmagicalenv;
+ eval { system("lskdfj"); };
+ test 207, $@ =~ /^%ENV is aliased to another variable while running with -T switch/;
+ local *ENV = *nonmagicalenv;
+ eval { system("lskdfj"); };
+ test 208, $@ =~ /^%ENV is aliased to %nonmagicalenv while running with -T switch/;
+}
+{
+ # [perl #24248]
+ $TAINT =~ /(.*)/;
+ test 209, !tainted($1);
+ my $notaint = $1;
+ test 210, !tainted($notaint);
+
+ my $l;
+ $notaint =~ /($notaint)/;
+ $l = $1;
+ test 211, !tainted($1);
+ test 212, !tainted($l);
+ $notaint =~ /($TAINT)/;
+ $l = $1;
+ test 213, tainted($1);
+ test 214, tainted($l);
+
+ $TAINT =~ /($notaint)/;
+ $l = $1;
+ test 215, !tainted($1);
+ test 216, !tainted($l);
+ $TAINT =~ /($TAINT)/;
+ $l = $1;
+ test 217, tainted($1);
+ test 218, tainted($l);
+
+ my $r;
+ ($r = $TAINT) =~ /($notaint)/;
+ test 219, !tainted($1);
+ ($r = $TAINT) =~ /($TAINT)/;
+ test 220, tainted($1);
+
+ # [perl #24674]
+ # accessing $^O shoudn't taint it as a side-effect;
+ # assigning tainted data to it is now an error
+
+ test 221, !tainted($^O);
+ if (!$^X) { } elsif ($^O eq 'bar') { }
+ test 222, !tainted($^O);
+ eval '$^O = $^X';
+ test 223, $@ =~ /Insecure dependency in/;
+}
+
+EFFECTIVELY_CONSTANTS: {
+ my $tainted_number = 12 + $TAINT0;
+ test 224, tainted( $tainted_number );
+
+ # Even though it's always 0, it's still tainted
+ my $tainted_product = $tainted_number * 0;
+ test 225, tainted( $tainted_product );
+ test 226, $tainted_product == 0;
+}
+
+TERNARY_CONDITIONALS: {
+ my $tainted_true = $TAINT . "blah blah blah";
+ my $tainted_false = $TAINT0;
+ test 227, tainted( $tainted_true );
+ test 228, tainted( $tainted_false );
+
+ my $result = $tainted_true ? "True" : "False";
+ test 229, $result eq "True";
+ test 230, !tainted( $result );
+
+ $result = $tainted_false ? "True" : "False";
+ test 231, $result eq "False";
+ test 232, !tainted( $result );
+
+ my $untainted_whatever = "The Fabulous Johnny Cash";
+ my $tainted_whatever = "Soft Cell" . $TAINT;
+
+ $result = $tainted_true ? $tainted_whatever : $untainted_whatever;
+ test 233, $result eq "Soft Cell";
+ test 234, tainted( $result );
+
+ $result = $tainted_false ? $tainted_whatever : $untainted_whatever;
+ test 235, $result eq "The Fabulous Johnny Cash";
+ test 236, !tainted( $result );
}