view release on metacpan or  search on metacpan

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

#   which doesn't spawn an external program.
SKIP: {
    skip "globs should be forbidden", 2 if 1 or $Is_VMS;

    my @globs = eval { <*> };
    test @globs == 0 && $@ =~ /^Insecure dependency/;

    @globs = eval { glob '*' };
    test @globs == 0 && $@ =~ /^Insecure dependency/;
}

# Output of commands should be tainted
{
    my $foo = `$echo abc`;
    test tainted $foo;
}

# Certain system variables should be tainted
{
    test all_tainted $^X, $0;
}

# Results of matching should all be untainted
{
    my $foo = "abcdefghi" . $TAINT;
    test tainted $foo;

    $foo =~ /def/;
    test not any_tainted $`, $&, $';

    $foo =~ /(...)(...)(...)/;
    test not any_tainted $1, $2, $3, $+;

    my @bar = $foo =~ /(...)(...)(...)/;
    test not any_tainted @bar;

    test tainted $foo;	# $foo should still be tainted!
    test $foo eq "abcdefghi";
}

# Operations which affect files can't use tainted data.
{
    test !eval { chmod 0, $TAINT }, 'chmod';
    test $@ =~ /^Insecure dependency/, $@;

    # There is no feature test in $Config{} for truncate,
    #   so we allow for the possibility that it's missing.
    test !eval { truncate 'NoSuChFiLe', $TAINT0 }, 'truncate';
    test $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;

    test !eval { rename '', $TAINT }, 'rename';
    test $@ =~ /^Insecure dependency/, $@;

    test !eval { unlink $TAINT }, 'unlink';
    test $@ =~ /^Insecure dependency/, $@;

    test !eval { utime $TAINT }, 'utime';
    test $@ =~ /^Insecure dependency/, $@;

    SKIP: {
        skip "chown() is not available", 2 unless $Config{d_chown};

	test !eval { chown -1, -1, $TAINT }, 'chown';
	test $@ =~ /^Insecure dependency/, $@;
    }

    SKIP: {
        skip "link() is not available", 2 unless $Config{d_link};

	test !eval { link $TAINT, '' }, 'link';
	test $@ =~ /^Insecure dependency/, $@;
    }

    SKIP: {
        skip "symlink() is not available", 2 unless $Config{d_symlink};

	test !eval { symlink $TAINT, '' }, 'symlink';
	test $@ =~ /^Insecure dependency/, $@;
    }
}

# Operations which affect directories can't use tainted data.
{
    test !eval { mkdir "foo".$TAINT, 0755.$TAINT0 }, 'mkdir';
    test $@ =~ /^Insecure dependency/, $@;

    test !eval { rmdir $TAINT }, 'rmdir';
    test $@ =~ /^Insecure dependency/, $@;

    test !eval { chdir "foo".$TAINT }, 'chdir';
    test $@ =~ /^Insecure dependency/, $@;

    SKIP: {
        skip "chroot() is not available", 2 unless $Config{d_chroot};

	test !eval { chroot $TAINT }, 'chroot';
	test $@ =~ /^Insecure dependency/, $@;
    }
}

# Some operations using files can't use tainted data.
{
    my $foo = "imaginary library" . $TAINT;
    test !eval { require $foo }, 'require';
    test $@ =~ /^Insecure dependency/, $@;

    my $filename = "./taintB$$";	# NB: $filename isn't tainted!
    END { unlink $filename if defined $filename }
    $foo = $filename . $TAINT;
    unlink $filename;	# in any case

    test !eval { open FOO, $foo }, 'open for read';
    test $@ eq '', $@;		# NB: This should be allowed

    # 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 eval('$!{ENOENT}') ||
	$! == 2 || # File not found
	($Is_Dos && $! == 22) ||
	($^O eq 'mint' && $! == 33);

    test !eval { open FOO, "> $foo" }, 'open for write';