view release on metacpan or  search on metacpan

misc/pX/Common/Regexp-Test-Perl5Tests/t/op/taint.t  view on Meta::CPAN

	test $@ =~ /^Insecure dependency/, $@;
	
	eval { sysopen(my $cr, "foo", &O_CREAT | $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;

	eval { sysopen(my $tr, "foo", &O_TRUNC | $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;

	eval { sysopen(my $ro, "foo", &O_RDONLY, $TAINT0) };
	test $@ !~ /^Insecure dependency/, $@;
	
	eval { sysopen(my $wo, "foo", &O_WRONLY, $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;
	
	eval { sysopen(my $rw, "foo", &O_RDWR, $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;
	
	eval { sysopen(my $ap, "foo", &O_APPEND, $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;
	
	eval { sysopen(my $cr, "foo", &O_CREAT, $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;

	eval { sysopen(my $tr, "foo", &O_TRUNC, $TAINT0) };
	test $@ =~ /^Insecure dependency/, $@;
	
	unlink("foo"); # not unlink($evil), because that would fail...
    }
}

{
    # bug 20010526.004

    use warnings;

    my $saw_warning = 0;
    local $SIG{__WARN__} = sub { $saw_warning = 1 };

    sub fmi {
	my $divnum = shift()/1;
	sprintf("%1.1f\n", $divnum);
    }

    fmi(21 . $TAINT);
    fmi(37);
    fmi(248);

    test !$saw_warning;
}


{
    # 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/;