+
+{
+ # 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;
+
+ ok $i == 1;
+}
+
+{
+ # Check that all environment variables are tainted.
+ my @untainted;
+ while (my ($k, $v) = each %ENV) {
+ if (!tainted($v) &&
+ # These we have explicitly untainted or set earlier.
+ $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|PERL_CORE|TEMP|TERM|TMP)$/) {
+ push @untainted, "# '$k' = '$v'\n";
+ }
+ }
+ test @untainted == 0, "untainted:\n @untainted";
+}
+
+
+ok( ${^TAINT} == 1, '$^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 tainted $re1;
+
+ my $re2 = qr/^$re1\z/;
+ test tainted $re2;
+
+ my $re3 = "$re2";
+ test tainted $re3;
+}
+
+SKIP: {
+ skip "system {} has different semantics on Win32", 1 if $Is_MSWin32;
+
+ # bug 20010221.005
+ local $ENV{PATH} .= $TAINT;
+ eval { system { "echo" } "/arg0", "arg1" };
+ test $@ =~ /^Insecure \$ENV/;
+}
+
+TODO: {
+ todo_skip 'tainted %ENV warning occludes tainted arguments warning', 22
+ if $Is_VMS;
+
+ # bug 20020208.005 plus some single arg exec/system extras
+ my $err = qr/^Insecure dependency/ ;
+ test !eval { exec $TAINT, $TAINT }, 'exec';
+ test $@ =~ $err, $@;
+ test !eval { exec $TAINT $TAINT }, 'exec';
+ test $@ =~ $err, $@;
+ test !eval { exec $TAINT $TAINT, $TAINT }, 'exec';
+ test $@ =~ $err, $@;
+ test !eval { exec $TAINT 'notaint' }, 'exec';
+ test $@ =~ $err, $@;
+ test !eval { exec {'notaint'} $TAINT }, 'exec';
+ test $@ =~ $err, $@;
+
+ test !eval { system $TAINT, $TAINT }, 'system';
+ test $@ =~ $err, $@;
+ test !eval { system $TAINT $TAINT }, 'system';
+ test $@ =~ $err, $@;
+ test !eval { system $TAINT $TAINT, $TAINT }, 'system';
+ test $@ =~ $err, $@;
+ test !eval { system $TAINT 'notaint' }, 'system';
+ test $@ =~ $err, $@;
+ test !eval { system {'notaint'} $TAINT }, 'system';
+ test $@ =~ $err, $@;
+
+ eval {
+ no warnings;
+ system("lskdfj does not exist","with","args");
+ };
+ test !$@;
+
+ SKIP: {
+ skip "no exec() on MacOS Classic" if $Is_MacOS;
+
+ eval {
+ no warnings;
+ exec("lskdfj does not exist","with","args");
+ };
+ test !$@;
+ }
+
+ # If you add tests here update also the above skip block for VMS.
+}
+
+{
+ # [ID 20020704.001] taint propagation failure
+ use re 'taint';
+ $TAINT =~ /(.*)/;
+ test tainted(my $foo = $1);
+}
+
+{
+ # [perl #24291] this used to dump core
+ our %nonmagicalenv = ( PATH => "util" );
+ local *ENV = \%nonmagicalenv;
+ eval { system("lskdfj"); };
+ test $@ =~ /^%ENV is aliased to another variable while running with -T switch/;
+ local *ENV = *nonmagicalenv;
+ eval { system("lskdfj"); };
+ test $@ =~ /^%ENV is aliased to %nonmagicalenv while running with -T switch/;
+}
+{
+ # [perl #24248]
+ $TAINT =~ /(.*)/;
+ test !tainted($1);
+ my $notaint = $1;
+ test !tainted($notaint);
+
+ my $l;
+ $notaint =~ /($notaint)/;
+ $l = $1;
+ test !tainted($1);
+ test !tainted($l);
+ $notaint =~ /($TAINT)/;
+ $l = $1;
+ test tainted($1);
+ test tainted($l);
+
+ $TAINT =~ /($notaint)/;
+ $l = $1;
+ test !tainted($1);
+ test !tainted($l);
+ $TAINT =~ /($TAINT)/;
+ $l = $1;
+ test tainted($1);
+ test tainted($l);
+
+ my $r;
+ ($r = $TAINT) =~ /($notaint)/;
+ test !tainted($1);
+ ($r = $TAINT) =~ /($TAINT)/;
+ test tainted($1);
+
+ # [perl #24674]
+ # accessing $^O shoudn't taint it as a side-effect;
+ # assigning tainted data to it is now an error
+
+ test !tainted($^O);
+ if (!$^X) { } elsif ($^O eq 'bar') { }
+ test !tainted($^O);
+ eval '$^O = $^X';
+ test $@ =~ /Insecure dependency in/;
+}
+
+EFFECTIVELY_CONSTANTS: {
+ my $tainted_number = 12 + $TAINT0;
+ test tainted( $tainted_number );
+
+ # Even though it's always 0, it's still tainted
+ my $tainted_product = $tainted_number * 0;
+ test tainted( $tainted_product );
+ test $tainted_product == 0;
+}
+
+TERNARY_CONDITIONALS: {
+ my $tainted_true = $TAINT . "blah blah blah";
+ my $tainted_false = $TAINT0;
+ test tainted( $tainted_true );
+ test tainted( $tainted_false );
+
+ my $result = $tainted_true ? "True" : "False";
+ test $result eq "True";
+ test !tainted( $result );
+
+ $result = $tainted_false ? "True" : "False";
+ test $result eq "False";
+ test !tainted( $result );
+
+ my $untainted_whatever = "The Fabulous Johnny Cash";
+ my $tainted_whatever = "Soft Cell" . $TAINT;
+
+ $result = $tainted_true ? $tainted_whatever : $untainted_whatever;
+ test $result eq "Soft Cell";
+ test tainted( $result );
+
+ $result = $tainted_false ? $tainted_whatever : $untainted_whatever;
+ test $result eq "The Fabulous Johnny Cash";
+ test !tainted( $result );
+}