X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Ftaint.t;h=7c83019e7cfc5f0e0f07a08fa8c182b41a63dd49;hb=0bc0ad857ef0ded50c72fba42503c958a1579a5a;hp=6a9537b05738ade924b596b37cf5617fb796f72e;hpb=72b166521443a1b89b0fed156fa8334cfab6e61b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/taint.t b/t/op/taint.t index 6a9537b..7c83019 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -9,28 +9,57 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib' if -d '../lib'; + @INC = '../lib'; } 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 # just because Errno possibly failing. eval { require Errno; import Errno }; +use vars qw($ipcsysv); # did we manage to load IPC::SysV? + BEGIN { if ($^O eq 'VMS' && !defined($Config{d_setenv})) { $ENV{PATH} = $ENV{PATH}; $ENV{TERM} = $ENV{TERM} ne ''? $ENV{TERM} : 'dummy'; } + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ + && ($Config{d_shm} || $Config{d_msg})) { + eval { require IPC::SysV }; + unless ($@) { + $ipcsysv++; + IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU)); + } + } } 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) { @@ -87,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..149\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 @@ -106,9 +135,15 @@ print "1..149\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" } } @@ -132,12 +167,12 @@ print "1..149\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 { $tmp = (grep { defined and -d and (stat _)[2] & 2 } - qw(/tmp /var/tmp /usr/tmp /sys$scratch), + qw(sys$scratch /tmp /var/tmp /usr/tmp), @ENV{qw(TMP TEMP)})[0] or print "# can't find world-writeable directory to test PATH\n"; } @@ -542,19 +577,19 @@ 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); test 142,( not tainted $getpwent[0] - and not tainted $getpwent[1] + and tainted $getpwent[1] and not tainted $getpwent[2] and not tainted $getpwent[3] and not tainted $getpwent[4] and not tainted $getpwent[5] - and tainted $getpwent[6] # gecos + and tainted $getpwent[6] # ge?cos and not tainted $getpwent[7] - and not tainted $getpwent[8]); + and tainted $getpwent[8]); # shell endpwent(); } else { for (142) { print "ok $_ # Skipped: getpwent() is not available\n" } @@ -605,3 +640,292 @@ else { $why =~ s/e/'-'.$$/ge; test 149, tainted $why; } + +# test shmread +{ + unless ($ipcsysv) { + print "ok 150 # skipped: no IPC::SysV\n"; + last; + } + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ && $Config{d_shm}) { + no strict 'subs'; + my $sent = "foobar"; + my $rcvd; + my $size = 2000; + my $id = shmget(IPC_PRIVATE, $size, S_IRWXU); + + if (defined $id) { + if (shmwrite($id, $sent, 0, 60)) { + if (shmread($id, $rcvd, 0, 60)) { + substr($rcvd, index($rcvd, "\0")) = ''; + } else { + warn "# shmread failed: $!\n"; + } + } else { + warn "# shmwrite failed: $!\n"; + } + shmctl($id, IPC_RMID, 0) or warn "# shmctl failed: $!\n"; + } else { + warn "# shmget failed: $!\n"; + } + + if ($rcvd eq $sent) { + test 150, tainted $rcvd; + } else { + print "ok 150 # Skipped: SysV shared memory operation failed\n"; + } + } else { + print "ok 150 # Skipped: SysV shared memory is not available\n"; + } +} + +# test msgrcv +{ + unless ($ipcsysv) { + print "ok 151 # skipped: no IPC::SysV\n"; + last; + } + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ && $Config{d_msg}) { + no strict 'subs'; + my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU); + + my $sent = "message"; + my $type_sent = 1234; + my $rcvd; + my $type_rcvd; + + if (defined $id) { + if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) { + if (msgrcv($id, $rcvd, 60, 0, 0)) { + ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd); + } else { + warn "# msgrcv failed\n"; + } + } else { + warn "# msgsnd failed\n"; + } + msgctl($id, IPC_RMID, 0) or warn "# msgctl failed: $!\n"; + } else { + warn "# msgget failed\n"; + } + + if ($rcvd eq $sent && $type_sent == $type_rcvd) { + test 151, tainted $rcvd; + } else { + print "ok 151 # Skipped: SysV message queue operation failed\n"; + } + } else { + print "ok 151 # Skipped: SysV message queues are not available\n"; + } +} + +{ + # bug id 20001004.006 + + open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ; + local $/; + my $a = ; + my $b = ; + print "not " unless tainted($a) && tainted($b) && !defined($b); + print "ok 152\n"; + close IN; +} + +{ + # bug id 20001004.007 + + open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ; + my $a = ; + + my $c = { a => 42, + b => $a }; + print "not " unless !tainted($c->{a}) && tainted($c->{b}); + print "ok 153\n"; + + my $d = { a => $a, + b => 42 }; + print "not " unless tainted($d->{a}) && !tainted($d->{b}); + print "ok 154\n"; + + my $e = { a => 42, + b => { c => $a, d => 42 } }; + print "not " unless !tainted($e->{a}) && + !tainted($e->{b}) && + tainted($e->{b}->{c}) && + !tainted($e->{b}->{d}); + print "ok 155\n"; + + 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/; +}