use File::Spec::Functions;
BEGIN { require './test.pl'; }
-plan tests => 298;
+plan tests => 319;
$| = 1;
}
}
-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_OpenBSD = $^O eq 'openbsd';
my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.exe' :
$Is_MSWin32 ? '.\perl' :
- $Is_MacOS ? ':perl' :
- $Is_NetWare ? '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_MacOS ? ":echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
+my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
END { unlink $ECHO }
open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
print PROG 'print "@ARGV\n"', "\n";
SKIP: {
skip "Environment tainting tests skipped", 4
- if $Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos || $Is_MacOS;
+ if $Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos;
my @vars = ('PATH', @MoreEnv);
while (my $v = $vars[0]) {
# How about command-line arguments? The problem is that we don't
# always get some, so we'll run another process with some.
SKIP: {
- my $arg = catfile(curdir(), tempfile());
+ my $arg = tempfile();
open PROG, "> $arg" or die "Can't create $arg: $!";
print PROG q{
eval { join('', @ARGV), kill 0 };
# just because Errno possibly failing.
test eval('$!{ENOENT}') ||
$! == 2 || # File not found
- ($Is_Dos && $! == 22) ||
- ($^O eq 'mint' && $! == 33);
+ ($Is_Dos && $! == 22);
test !eval { open FOO, "> $foo" }, 'open for write';
test $@ =~ /^Insecure dependency/, $@;
unlink($symlink);
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 tainted $readlink;
};
test !$@;
- SKIP: {
- skip "no exec() on MacOS Classic" if $Is_MacOS;
-
- eval {
- no warnings;
- exec("lskdfj does not exist","with","args");
- };
- test !$@;
- }
+ eval {
+ no warnings;
+ exec("lskdfj does not exist","with","args");
+ };
+ test !$@;
# If you add tests here update also the above skip block for VMS.
}
}
}
+# Bug RT #52552 - broken by change at git commit id f337b08
+{
+ my $x = $TAINT. q{print "Hello world\n"};
+ my $y = pack "a*", $x;
+ ok(tainted($y), "pack a* preserves tainting");
+
+ my $z = pack "A*", q{print "Hello world\n"}.$TAINT;
+ ok(tainted($z), "pack A* preserves tainting");
+
+ my $zz = pack "a*a*", q{print "Hello world\n"}, $TAINT;
+ ok(tainted($zz), "pack a*a* preserves tainting");
+}
+
+# Bug RT #61976 tainted $! would show numeric rather than string value
+
+{
+ my $tainted_path = substr($^X,0,0) . "/no/such/file";
+ my $err;
+ # $! is used in a tainted expression, so gets tainted
+ open my $fh, $tainted_path or $err= "$!";
+ unlike($err, qr/^\d+$/, 'tainted $!');
+}
+
+{
+ # #6758: tainted values become untainted in tied hashes
+ # (also applies to other value magic such as pos)
+
+
+ package P6758;
+
+ sub TIEHASH { bless {} }
+ sub TIEARRAY { bless {} }
+
+ my $i = 0;
+
+ sub STORE {
+ main::ok(main::tainted($_[1]), "tied arg1 tainted");
+ main::ok(main::tainted($_[2]), "tied arg2 tainted");
+ $i++;
+ }
+
+ package main;
+
+ my ($k,$v) = qw(1111 val);
+ taint_these($k,$v);
+ tie my @array, 'P6758';
+ tie my %hash , 'P6758';
+ $array[$k] = $v;
+ $hash{$k} = $v;
+ ok $i == 2, "tied STORE called correct number of times";
+}
+
+# Bug RT #45167 the return value of sprintf sometimes wasn't tainted
+# when the args were tainted. This only occured on the first use of
+# sprintf; after that, its TARG has taint magic attached, so setmagic
+# at the end works. That's why there are multiple sprintf's below, rather
+# than just one wrapped in an inner loop. Also, any plantext betwerrn
+# fprmat entires would correctly cause tainting to get set. so test with
+# "%s%s" rather than eg "%s %s".
+
+{
+ for my $var1 ($TAINT, "123") {
+ for my $var2 ($TAINT0, "456") {
+ my @s;
+ push @s, sprintf '%s', $var1, $var2;
+ push @s, sprintf ' %s', $var1, $var2;
+ push @s, sprintf '%s%s', $var1, $var2;
+ for (0..2) {
+ ok( !(
+ tainted($s[$_]) xor
+ (tainted($var1) || ($_==2 && tainted($var2)))
+ ),
+ "sprintf fmt$_, '$var1', '$var2'");
+ }
+ }
+ }
+}
+
+
+
# This may bomb out with the alarm signal so keep it last
SKIP: {
skip "No alarm()" unless $Config{d_alarm};