#!./perl -T
#
# Taint tests by Tom Phoenix <rootbeer@teleport.com>.
#
# I don't claim to know all about tainting. If anyone sees
# tests that I've missed here, please add them. But this is
# better than having no tests at all, right?
#
BEGIN {
chdir 't' if -d 't';
}
use strict;
use Config;
my $test = 177;
# You have to do it this way or VMS will get confused.
$test++;
return $ok;
}
$| = 1;
BEGIN {
}
$ipcsysv++;
}
}
}
}
eval <<EndOfCleanup;
END {
\$ENV{PATH} = '' if $Config{d_setenv};
warn "# Note: logical name 'PATH' may have been deleted\n";
\@ENV{keys %old} = values %old;
}
EndOfCleanup
}
# Sources of taint:
# The empty tainted value, for tainting strings
# A tainted zero, useful for tainting numbers
# This taints each argument passed. All must be lvalues.
# Side effect: It also stringifies them. :-(
}
# How to identify taint when you see it
}
any_tainted @_;
}
1;
}
sub test ($$;$) {
} else {
print "# $_";
}
}
}
# We need an external program to call.
my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : $Is_MacOS ? ":echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
print "1..223\n";
# First, let's make sure that Perl is checking the dangerous
# environment variables. Maybe they aren't set yet, so we'll
# taint them ourselves.
{
eval q{
};
}
eval q{
};
}
print "# Environment tainting tests skipped\n";
for (2..5) { print "ok $_\n" }
}
else {
shift @vars;
}
# tainted $TERM is unsafe only if it contains metachars
}
my $tmp;
print "# all directories are writeable\n";
}
else {
}
}
else {
for (6..7) { print "ok $_ # Skipped: all directories are writeable\n" }
}
}
else {
for (10..11) { print "ok $_ # Skipped: can't find world-writeable directory to test DCL\$PATH\n" }
}
}
else {
for (8..11) { print "ok $_ # Skipped: This is not VMS\n"; }
}
}
# Let's see that we can taint and untaint as needed.
{
# That was a sanity check. If it failed, stop the insanity!
my @list = 1..10;
test 15, not any_tainted @list;
taint_these @list[1,3,5,7,9];
test 16, any_tainted @list;
test 17, all_tainted @list[1,3,5,7,9];
test 18, not any_tainted @list[0,2,4,6,8];
{
}
}
# How about command-line arguments? The problem is that we don't
# always get some, so we'll run another process with some.
SKIP: {
print PROG q{
exit 0 if $@ =~ /^Insecure dependency/;
print "# Oops: \$@ was [$@]\n";
exit 1;
};
test 31, !$?, "Exited with status $?";
}
# Reading from a file should be tainted
{
my $block;
}
# Globs should be forbidden, except under VMS,
# which doesn't spawn an external program.
if (1 # built-in glob
for (35..36) { print "ok $_\n"; }
}
else {
my @globs = eval { <*> };
test 35, @globs == 0 && $@ =~ /^Insecure dependency/;
test 36, @globs == 0 && $@ =~ /^Insecure dependency/;
}
# Output of commands should be tainted
{
}
# Certain system variables should be tainted
{
test 38, all_tainted $^X, $0;
}
# Results of matching should all be untainted
{
$foo =~ /(...)(...)(...)/;
test 41, not any_tainted $1, $2, $3, $+;
my @bar = $foo =~ /(...)(...)(...)/;
test 42, not any_tainted @bar;
test 43, tainted $foo; # $foo should still be tainted!
test 44, $foo eq "abcdefghi";
}
{
test 46, $@ =~ /^Insecure dependency/, $@;
# There is no feature test in $Config{} for truncate,
# so we allow for the possibility that it's missing.
test 50, $@ =~ /^Insecure dependency/, $@;
test 52, $@ =~ /^Insecure dependency/, $@;
test 54, $@ =~ /^Insecure dependency/, $@;
test 56, $@ =~ /^Insecure dependency/, $@;
}
else {
for (55..56) { print "ok $_ # Skipped: chown() is not available\n" }
}
test 58, $@ =~ /^Insecure dependency/, $@;
}
else {
for (57..58) { print "ok $_ # Skipped: link() is not available\n" }
}
test 60, $@ =~ /^Insecure dependency/, $@;
}
else {
for (59..60) { print "ok $_ # Skipped: symlink() is not available\n" }
}
}
# Operations which affect directories can't use tainted data.
{
test 62, $@ =~ /^Insecure dependency/, $@;
test 64, $@ =~ /^Insecure dependency/, $@;
test 66, $@ =~ /^Insecure dependency/, $@;
test 68, $@ =~ /^Insecure dependency/, $@;
}
else {
for (67..68) { print "ok $_ # Skipped: chroot() is not available\n" }
}
}
# Some operations using files can't use tainted data.
{
test 70, $@ =~ /^Insecure dependency/, $@;
# Try first new style but allow also old style.
# We do not want the whole taint.t to fail
# just because Errno possibly failing.
test 73, eval('$!{ENOENT}') ||
$! == 2 || # File not found
test 75, $@ =~ /^Insecure dependency/, $@;
}
# Commands to the system can't use tainted data
{
for (76..79) { print "ok $_ # Skipped: open('|') is not available\n" }
}
else {
test 77, $@ =~ /^Insecure dependency/, $@;
test 79, $@ =~ /^Insecure dependency/, $@;
}
test 81, $@ =~ /^Insecure dependency/, $@;
test 83, $@ =~ /^Insecure dependency/, $@;
test 85, $@ =~ /^Insecure dependency/, $@;
}
else {
for (86..87) { print "ok $_ # Skipped: This is not VMS\n"; }
}
}
# Operations which affect processes can't use tainted data.
{
test 89, $@ =~ /^Insecure dependency/, $@;
test 91, $@ =~ /^Insecure dependency/, $@;
}
else {
for (90..91) { print "ok $_ # Skipped: setpgrp() is not available\n" }
}
test 93, $@ =~ /^Insecure dependency/, $@;
}
else {
for (92..93) { print "ok $_ # Skipped: setpriority() is not available\n" }
}
}
# Some miscellaneous operations can't use tainted data.
{
test 95, $@ =~ /^Insecure dependency/, $@;
}
else {
for (94..95) { print "ok $_ # Skipped: syscall() is not available\n" }
}
{
local *FOO;
test 98, $@ =~ /^Insecure dependency/, $@;
test 100, $@ =~ /^Insecure dependency/, $@;
}
else {
for (99..100) { print "ok $_ # Skipped: fcntl() is not available\n" }
}
}
}
# Some tests involving references
{
}
# Some tests involving assignment
{
test 104, all_tainted $foo, $bar;
test 117, $bar == 0;
}
# Test assignment and return of lists
{
my @corge = &$red_october;
}
{
# No reliable %Config check for getpw*
} else {
for (142) { print "ok $_ # Skipped: getpwent() is not available\n" }
}
local(*D);
} else {
for (143) { print "ok $_ # Skipped: readdir() is not available\n" }
}
# it has to be a real path on Mac OS
} else {
for (144) { print "ok $_ # Skipped: readlink() or symlink() is not available\n"; }
}
}
# test bitwise ops (regression bug)
{
test 146, tainted $j;
}
# test target of substitution (regression bug)
{
$why =~ s/y/z/;
my $z = "[z]";
}
# test shmread
{
print "ok 150 # skipped: no IPC::SysV\n";
last;
}
my $rcvd;
my $size = 2000;
} else {
}
} else {
}
} else {
}
} 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
{
print "ok 151 # skipped: no IPC::SysV\n";
last;
}
my $type_sent = 1234;
my $rcvd;
my $type_rcvd;
} else {
}
} else {
}
} else {
}
} 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
local $/;
my $a = <IN>;
my $b = <IN>;
print "ok 152\n";
}
{
# bug id 20001004.007
my $a = <IN>;
my $c = { a => 42,
b => $a };
print "ok 153\n";
my $d = { a => $a,
b => 42 };
print "ok 154\n";
my $e = { a => 42,
b => { c => $a, d => 42 } };
print "ok 155\n";
}
{
# bug id 20010519.003
BEGIN {
$has_fcntl = 1;
}
}
for (156..173) {
print "ok $_ # Skip: no Fcntl (no dynaloading?)\n";
}
} else {
test 156, $@ !~ /^Insecure dependency/, $@;
test 157, $@ =~ /^Insecure dependency/, $@;
test 158, $@ =~ /^Insecure dependency/, $@;
test 159, $@ =~ /^Insecure dependency/, $@;
test 160, $@ =~ /^Insecure dependency/, $@;
test 161, $@ =~ /^Insecure dependency/, $@;
test 162, $@ !~ /^Insecure dependency/, $@;
test 163, $@ =~ /^Insecure dependency/, $@;
test 164, $@ =~ /^Insecure dependency/, $@;
test 165, $@ =~ /^Insecure dependency/, $@;
test 166, $@ =~ /^Insecure dependency/, $@;
test 167, $@ =~ /^Insecure dependency/, $@;
test 168, $@ !~ /^Insecure dependency/, $@;
test 169, $@ =~ /^Insecure dependency/, $@;
test 170, $@ =~ /^Insecure dependency/, $@;
test 171, $@ =~ /^Insecure dependency/, $@;
test 172, $@ =~ /^Insecure dependency/, $@;
test 173, $@ =~ /^Insecure dependency/, $@;
}
}
{
# bug 20010526.004
use warnings;
sub fmi {
}
print "ok 174\n";
}
{
# Bug ID 20010730.010
my $i = 0;
my $class = shift;
my $arg = shift;
}
$i ++;
${$_ [0]}
}
print $i == 1 ? "ok 175\n" : "not ok 175\n"
}
{
# Check that all environment variables are tainted.
my @untainted;
# These we have explicitly untainted or set earlier.
}
}
}
eval { ${^TAINT} = 0 };
'Assigning to ${^TAINT} fails' );
{
# bug 20011111.105
}
print "ok 183 # Skipped: system {} has different semantics\n";
}
else
{
# bug 20010221.005
}
for (184..205) {print "not ok $_ # TODO tainted %ENV warning occludes tainted arguments warning\n";}
}
else
{
# bug 20020208.005 plus some extras
my $err = qr/^Insecure dependency/ ;
test 185, $@ =~ $err, $@;
test 187, $@ =~ $err, $@;
test 189, $@ =~ $err, $@;
test 191, $@ =~ $err, $@;
test 193, $@ =~ $err, $@;
test 195, $@ =~ $err, $@;
test 197, $@ =~ $err, $@;
test 199, $@ =~ $err, $@;
test 201, $@ =~ $err, $@;
test 203, $@ =~ $err, $@;
print "ok 205 # no exec()\n";
} else {
eval { exec("lskdfj does not exist","with","args"); };
}
# If you add tests here update also the above skip block for VMS.
}
{
# [ID 20020704.001] taint propagation failure
}
{
# Remove this when changes 21542 and 21563 are integrated
test 207, 1;
test 208, 1;
}
{
# [perl #24248]
my $notaint = $1;
my $l;
$l = $1;
$l = $1;
$l = $1;
$l = $1;
my $r;
# [perl #24674]
# accessing $^O shoudn't taint it as a side-effect;
# assigning tainted data to it is now an error
eval '$^O = $^X';
test 223, $@ =~ /Insecure dependency in/;
}