use strict;
use Config;
+use File::Spec::Functions;
my $test = 177;
sub ok ($;$) {
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 $Is_MacOS = $^O eq 'MacOS';
my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $Is_NetWare = $^O eq 'NetWare';
my $Is_Cygwin = $^O eq 'cygwin';
my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
($Is_MSWin32 ? '.\perl' :
+ $Is_MacOS ? ':perl' :
($Is_NetWare ? 'perl' : './perl'));
my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
}
# We need an external program to call.
-my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
+my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : $Is_MacOS ? ":echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
END { unlink $ECHO }
open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
print PROG 'print "@ARGV\n"', "\n";
close PROG;
my $echo = "$Invoke_Perl $ECHO";
-print "1..183\n";
+my $TEST = catfile(curdir(), 'TEST');
+
+print "1..206\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
test 1, eval { `$echo 1` } eq "1\n";
- if ($Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos) {
+ if ($Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos || $Is_MacOS) {
print "# Environment tainting tests skipped\n";
for (2..5) { print "ok $_\n" }
}
# How about command-line arguments? The problem is that we don't
# always get some, so we'll run another process with some.
-{
- my $arg = "./arg$$";
+SKIP: {
+ my $arg = catfile(curdir(), "arg$$");
open PROG, "> $arg" or die "Can't create $arg: $!";
print PROG q{
eval { join('', @ARGV), kill 0 };
# Reading from a file should be tainted
{
- my $file = './TEST';
- test 32, open(FILE, $file), "Couldn't open '$file': $!";
+ test 32, open(FILE, $TEST), "Couldn't open '$TEST': $!";
my $block;
sysread(FILE, $block, 100);
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"; }
}
}
if ($Config{d_readlink} && $Config{d_symlink}) {
my $symlink = "sl$$";
unlink($symlink);
- symlink("/something/naughty", $symlink) or die "symlink: $!\n";
+ my $sl = "/something/naughty";
+ # it has to be a real path on Mac OS
+ $sl = MacPerl::MakePath((MacPerl::Volumes())[0]) if $Is_MacOS;
+ symlink($sl, $symlink) or die "symlink: $!\n";
my $readlink = readlink($symlink);
test 144, tainted $readlink;
unlink($symlink);
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 {
{
# bug id 20001004.006
- open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ;
+ open IN, $TEST or warn "$0: cannot read $TEST: $!" ;
local $/;
my $a = <IN>;
my $b = <IN>;
{
# bug id 20001004.007
- open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ;
+ open IN, $TEST or warn "$0: cannot read $TEST: $!" ;
my $a = <IN>;
my $c = { a => 42,
use warnings;
- $SIG{__WARN__} = sub { print "not " };
+ local $SIG{__WARN__} = sub { print "not " };
sub fmi {
my $divnum = shift()/1;
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' );
eval { system { "echo" } "/arg0", "arg1" };
test 183, $@ =~ /^Insecure \$ENV/;
}
+if ($Is_VMS) {
+ 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
+ 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 187, $@ =~ $err, $@;
+ test 188, eval { exec $TAINT $TAINT, $TAINT } eq '', 'exec';
+ test 189, $@ =~ $err, $@;
+ test 190, eval { exec $TAINT 'notaint' } eq '', 'exec';
+ test 191, $@ =~ $err, $@;
+ test 192, eval { exec {'notaint'} $TAINT } eq '', 'exec';
+ test 193, $@ =~ $err, $@;
+
+ test 194, eval { system $TAINT, $TAINT } eq '', 'system';
+ test 195, $@ =~ $err, $@;
+ test 196, eval { system $TAINT $TAINT } eq '', 'system';
+ test 197, $@ =~ $err, $@;
+ test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'system';
+ test 199, $@ =~ $err, $@;
+ test 200, eval { system $TAINT 'notaint' } eq '', 'system';
+ test 201, $@ =~ $err, $@;
+ 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);
+}