view release on metacpan or  search on metacpan

t/op/taint.t  view on Meta::CPAN

	my $evil = $foo . $TAINT;

	is(eval { sysopen(my $ro, $evil, &O_RDONLY) }, undef);
	is($@, '');

	violates_taint(sub { sysopen(my $wo, $evil, &O_WRONLY) }, 'sysopen');
	violates_taint(sub { sysopen(my $rw, $evil, &O_RDWR) }, 'sysopen');
	violates_taint(sub { sysopen(my $ap, $evil, &O_APPEND) }, 'sysopen');
	violates_taint(sub { sysopen(my $cr, $evil, &O_CREAT) }, 'sysopen');
	violates_taint(sub { sysopen(my $tr, $evil, &O_TRUNC) }, 'sysopen');

	is(eval { sysopen(my $ro, $foo, &O_RDONLY | $TAINT0) }, undef);
	is($@, '');

	violates_taint(sub { sysopen(my $wo, $foo, &O_WRONLY | $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $rw, $foo, &O_RDWR | $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $ap, $foo, &O_APPEND | $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $cr, $foo, &O_CREAT | $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $tr, $foo, &O_TRUNC | $TAINT0) }, 'sysopen');
	is(eval { sysopen(my $ro, $foo, &O_RDONLY, $TAINT0) }, undef);
	is($@, '');

	violates_taint(sub { sysopen(my $wo, $foo, &O_WRONLY, $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $rw, $foo, &O_RDWR, $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $ap, $foo, &O_APPEND, $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $cr, $foo, &O_CREAT, $TAINT0) }, 'sysopen');
	violates_taint(sub { sysopen(my $tr, $foo, &O_TRUNC, $TAINT0) }, 'sysopen');
    }
}

{
    # bug 20010526.004 (#7041)

    use warnings;

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

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

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

    is($saw_warning, 0);
}


{
    # Bug ID 20010730.010 (#7387)

    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|PERL5LIB)$/) {
	    push @untainted, "# '$k' = '$v'\n";
	}
    }
    is("@untainted", "", "untainted");
}


is(${^TAINT}, 1, '$^TAINT is on');

eval { ${^TAINT} = 0 };
is(${^TAINT}, 1, '$^TAINT is not assignable');
like($@, qr/^Modification of a read-only value attempted/,
     'Assigning to ${^TAINT} fails');

{
    # bug 20011111.105 (#7897)
    
    my $re1 = qr/x$TAINT/;
    is_tainted($re1);
    
    my $re2 = qr/^$re1\z/;
    is_tainted($re2);
    
    my $re3 = "$re2";
    is_tainted($re3);
}

SKIP: {
    skip "system {} has different semantics on Win32", 1 if $Is_MSWin32;

    # bug 20010221.005 (#5882)
    local $ENV{PATH} .= $TAINT;
    eval { system { "echo" } "/arg0", "arg1" };
    like($@, qr/^Insecure \$ENV/);