X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Ftaint.t;h=7c83019e7cfc5f0e0f07a08fa8c182b41a63dd49;hb=0bc0ad857ef0ded50c72fba42503c958a1579a5a;hp=8ff566e7f665140174c87a0e06a2f897541b0578;hpb=0ecd3ba2f9cc10124e1b1548816d989cfc59a802;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/taint.t b/t/op/taint.t index 8ff566e..7c83019 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -15,6 +15,20 @@ BEGIN { use strict; use Config; +my $test = 177; +sub ok { + my($ok, $name) = @_; + + # You have to do it this way or VMS will get confused. + print $ok ? "ok $test - $name\n" : "not ok $test - $name\n"; + + printf "# Failed test at line %d\n", (caller)[2] unless $ok; + + $test++; + return $ok; +} + + $| = 1; # We do not want the whole taint.t to fail @@ -40,9 +54,12 @@ BEGIN { my $Is_VMS = $^O eq 'VMS'; my $Is_MSWin32 = $^O eq 'MSWin32'; +my $Is_NetWare = $^O eq 'NetWare'; my $Is_Dos = $^O eq 'dos'; +my $Is_Cygwin = $^O eq 'cygwin'; my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' : - $Is_MSWin32 ? '.\perl' : './perl'; + ($Is_MSWin32 ? '.\perl' : + ($Is_NetWare ? 'perl' : './perl')); my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/; if ($Is_VMS) { @@ -99,14 +116,14 @@ sub test ($$;$) { } # We need an external program to call. -my $ECHO = ($Is_MSWin32 ? ".\\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"; close PROG; my $echo = "$Invoke_Perl $ECHO"; -print "1..155\n"; +print "1..183\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -118,9 +135,15 @@ print "1..155\n"; delete @ENV{@MoreEnv}; $ENV{TERM} = 'dumb'; + 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... + } + test 1, eval { `$echo 1` } eq "1\n"; - if ($Is_MSWin32 || $Is_VMS || $Is_Dos) { + if ($Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos) { print "# Environment tainting tests skipped\n"; for (2..5) { print "ok $_\n" } } @@ -144,7 +167,7 @@ print "1..155\n"; } my $tmp; - if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) { + if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_NetWare || $Is_Dos) { print "# all directories are writeable\n"; } else { @@ -554,7 +577,7 @@ else { # Test for system/library calls returning string data of dubious origin. { # No reliable %Config check for getpw* - if (eval { setpwent(); getpwent(); 1 }) { + if (eval { setpwent(); getpwent() }) { setpwent(); my @getpwent = getpwent(); die "getpwent: $!\n" unless (@getpwent); @@ -735,3 +758,174 @@ else { close IN; } +{ + # bug id 20010519.003 + + BEGIN { + use vars qw($has_fcntl); + eval { require Fcntl; import Fcntl; }; + unless ($@) { + $has_fcntl = 1; + } + } + + unless ($has_fcntl) { + for (156..173) { + print "ok $_ # Skip: no Fcntl (no dynaloading?)\n"; + } + } else { + my $evil = "foo" . $TAINT; + + eval { sysopen(my $ro, $evil, &O_RDONLY) }; + test 156, $@ !~ /^Insecure dependency/, $@; + + eval { sysopen(my $wo, $evil, &O_WRONLY) }; + test 157, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $rw, $evil, &O_RDWR) }; + test 158, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $ap, $evil, &O_APPEND) }; + test 159, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $cr, $evil, &O_CREAT) }; + test 160, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $tr, $evil, &O_TRUNC) }; + test 161, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $ro, "foo", &O_RDONLY | $evil) }; + test 162, $@ !~ /^Insecure dependency/, $@; + + eval { sysopen(my $wo, "foo", &O_WRONLY | $evil) }; + test 163, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $rw, "foo", &O_RDWR | $evil) }; + test 164, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $ap, "foo", &O_APPEND | $evil) }; + test 165, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $cr, "foo", &O_CREAT | $evil) }; + test 166, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $tr, "foo", &O_TRUNC | $evil) }; + test 167, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $ro, "foo", &O_RDONLY, $evil) }; + test 168, $@ !~ /^Insecure dependency/, $@; + + eval { sysopen(my $wo, "foo", &O_WRONLY, $evil) }; + test 169, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $rw, "foo", &O_RDWR, $evil) }; + test 170, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $ap, "foo", &O_APPEND, $evil) }; + test 171, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $cr, "foo", &O_CREAT, $evil) }; + test 172, $@ =~ /^Insecure dependency/, $@; + + eval { sysopen(my $tr, "foo", &O_TRUNC, $evil) }; + test 173, $@ =~ /^Insecure dependency/, $@; + + unlink("foo"); # not unlink($evil), because that would fail... + } +} + +{ + # bug 20010526.004 + + use warnings; + + $SIG{__WARN__} = sub { print "not " }; + + sub fmi { + my $divnum = shift()/1; + sprintf("%1.1f\n", $divnum); + } + + fmi(21 . $TAINT); + fmi(37); + fmi(248); + + print "ok 174\n"; +} + + +{ + # Bug ID 20010730.010 + + my $i = 0; + + sub Tie::TIESCALAR { + my $class = shift; + my $arg = shift; + + bless \$arg => $class; + } + + sub Tie::FETCH { + $i ++; + ${$_ [0]} + } + + + package main; + + my $bar = "The Big Bright Green Pleasure Machine"; + taint_these $bar; + tie my ($foo), Tie => $bar; + + my $baz = $foo; + + print $i == 1 ? "ok 175\n" : "not ok 175\n" + +} + +{ + # Check that all environment variables are tainted. + 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)$/) { + push @untainted, "# '$k' = '$v'\n"; + } + } + print @untainted == 0 ? "ok 176\n" : "not ok 176\n"; + print "# untainted:\n", @untainted if @untainted; +} + + +ok( ${^TAINT}, '$^TAINT is on' ); + +eval { ${^TAINT} = 0 }; +ok( ${^TAINT}, '$^TAINT is not assignable' ); +ok( $@ =~ /^Modification of a read-only value attempted/, + 'Assigning to ${^TAINT} fails' ); + +{ + # bug 20011111.105 + + my $re1 = qr/x$TAINT/; + test 180, tainted $re1; + + my $re2 = qr/^$re1\z/; + test 181, tainted $re2; + + my $re3 = "$re2"; + test 182, tainted $re3; +} + +if ($Is_MSWin32) { + print "ok 183 # Skipped: system {} has different semantics\n"; +} +else +{ + # bug 20010221.005 + local $ENV{PATH} .= $TAINT; + eval { system { "echo" } "/arg0", "arg1" }; + test 183, $@ =~ /^Insecure \$ENV/; +}