This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
numeric.c:S_mulexp10 -- quit when you can
[perl5.git] / t / op / taint.t
index 7c83019..bbe643c 100755 (executable)
@@ -14,9 +14,10 @@ BEGIN {
 
 use strict;
 use Config;
+use File::Spec::Functions;
 
 my $test = 177;
-sub ok {
+sub ok ($;$) {
     my($ok, $name) = @_;
 
     # You have to do it this way or VMS will get confused.
@@ -31,10 +32,6 @@ sub ok {
 
 $| = 1;
 
-# We do not want the whole taint.t to fail
-# just because Errno possibly failing.
-eval { require Errno; import Errno };
-
 use vars qw($ipcsysv); # did we manage to load IPC::SysV?
 
 BEGIN {
@@ -52,6 +49,7 @@ BEGIN {
   }
 }
 
+my $Is_MacOS = $^O eq 'MacOS';
 my $Is_VMS = $^O eq 'VMS';
 my $Is_MSWin32 = $^O eq 'MSWin32';
 my $Is_NetWare = $^O eq 'NetWare';
@@ -59,6 +57,7 @@ my $Is_Dos = $^O eq 'dos';
 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/;
 
@@ -116,14 +115,16 @@ sub test ($$;$) {
 }
 
 # 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..203\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -143,7 +144,7 @@ print "1..183\n";
 
     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" }
     }
@@ -259,8 +260,8 @@ print "1..183\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 };
@@ -276,8 +277,7 @@ print "1..183\n";
 
 # 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);
@@ -409,7 +409,9 @@ else {
     test 72, $@ eq '', $@;             # NB: This should be allowed
 
     # Try first new style but allow also old style.
-    test 73, $!{ENOENT} ||
+    # We do not want the whole taint.t to fail
+    # just because Errno possibly failing.
+    test 73, eval('$!{ENOENT}') ||
        $! == 2 || # File not found
        ($Is_Dos && $! == 22) ||
        ($^O eq 'mint' && $! == 33);
@@ -608,7 +610,10 @@ else {
     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);
@@ -722,7 +727,7 @@ 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>;
@@ -734,7 +739,7 @@ else {
 {
     # 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,
@@ -839,7 +844,7 @@ else {
 
     use warnings;
 
-    $SIG{__WARN__} = sub { print "not " };
+    local $SIG{__WARN__} = sub { print "not " };
 
     sub fmi {
        my $divnum = shift()/1;
@@ -929,3 +934,35 @@ else
     eval { system { "echo" } "/arg0", "arg1" };
     test 183, $@ =~ /^Insecure \$ENV/;
 }
+if ($Is_VMS) {
+    for (184..203) {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/;
+    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 '', 'exec';
+    test 197, $@ =~ $err, $@;
+    test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'exec';
+    test 199, $@ =~ $err, $@;
+    test 200, eval { system $TAINT 'notaint' } eq '', 'exec';
+    test 201, $@ =~ $err, $@;
+    test 202, eval { system {'notaint'} $TAINT } eq '', 'exec';
+    test 203, $@ =~ $err, $@;
+}