X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-CGI-Ex;a=blobdiff_plain;f=t%2F1_validate_14_untaint.t;h=0af323b33494b6f9c0fb6085ef24c14650cf7031;hp=59d256db1654d7f62f3904288a9e4405a13abb8a;hb=4eee158dce82376f2f37de29d91c53f60a24aebe;hpb=85070b46d0a93ddbeef07341421adb8389a55418 diff --git a/t/1_validate_14_untaint.t b/t/1_validate_14_untaint.t index 59d256d..0af323b 100644 --- a/t/1_validate_14_untaint.t +++ b/t/1_validate_14_untaint.t @@ -1,12 +1,21 @@ #!perl -T # -*- Mode: Perl; -*- -use strict; +=head1 NAME + +1_validate_14_untaint.t - Test CGI::Ex::Validate's ability to untaint tested fields -$^W = 1; +=cut + +use strict; +use Test::More tests => 14; +use FindBin qw($Bin); +use lib ($Bin =~ /(.+)/ ? "$1/../lib" : ''); # add bin - but untaint it ### Set up taint checking -sub is_tainted { local $^W = 0; ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 } } +sub is_tainted { local $^W = 0; ! eval { eval("#" . substr(join("", @_), 0, 0)); 1; 0 } } + +SKIP: { my $taint = join(",", $0, %ENV, @ARGV); if (! is_tainted($taint) && open(my $fh, "/dev/urandom")) { @@ -14,8 +23,7 @@ if (! is_tainted($taint) && open(my $fh, "/dev/urandom")) { } $taint = substr($taint, 0, 0); if (! is_tainted($taint)) { - print "1..1\nok 1 # skip Couldn't get any tainted data or we aren't in taint mode\n"; - exit; + skip("is_tainted doesn't appear to work", 14); } ### make sure tainted hash values don't bleed into other values @@ -23,83 +31,68 @@ my $form = {}; $form->{'foo'} = "123$taint"; $form->{'bar'} = "456$taint"; $form->{'baz'} = "789"; -if (! is_tainted($form->{'foo'}) - || is_tainted($form->{'baz'})) { - # untaint checking doesn't really work - print "1..1\nok 1 # skip Hashes with mixed taint don't work right (older perls ?)\n"; - exit; +if (! is_tainted($form->{'foo'})) { + skip("Tainted hash key didn't work right", 14); +} elsif (is_tainted($form->{'baz'})) { + # untaint checking doesn't really work + skip("Hashes with mixed taint don't work right", 14); } ###----------------------------------------------------------------### ### Looks good - here we go -### determine number of tests -seek(DATA,0,0); -my $prog = join "", ; -my @tests = ($prog =~ /print_ok\(/g); -my $tests = @tests; -print "1..$tests\n"; +use_ok('CGI::Ex::Validate'); -require CGI::Ex::Validate; +my $e; -my ($N, $v, $e, $ok) = (0); +ok(is_tainted($taint)); +ok(is_tainted($form->{'foo'})); +ok(! is_tainted($form->{'baz'})); +ok(! is_tainted($form->{'non_existent_key'})); +sub validate { scalar CGI::Ex::Validate::validate(@_) } -print_ok(is_tainted($taint)); -print_ok(is_tainted($form->{'foo'})); -print_ok(! is_tainted($form->{'baz'})); -print_ok(! is_tainted($form->{'non_existent_key'})); - -sub validate { - return scalar &CGI::Ex::Validate::validate(@_); -} -sub print_ok { - my $ok = shift; - $N ++; - warn "Test failed at line ".(caller)[2]."\n" if ! $ok; - print "" . ($ok ? "" : "not ") . "ok $N\n"; -} -&print_ok(1); ###----------------------------------------------------------------### -$e = &validate($form, { +$e = validate($form, { foo => { match => 'm/^\d+$/', untaint => 1, }, }); -print_ok(! $e); -print_ok(! is_tainted($form->{foo})); +ok(! $e); +ok(! is_tainted($form->{foo})); ###----------------------------------------------------------------### -$e = &validate($form, { +$e = validate($form, { bar => { match => 'm/^\d+$/', }, }); -print_ok(! $e); -print_ok(is_tainted($form->{bar})); +ok(! $e); +ok(is_tainted($form->{bar})); ###----------------------------------------------------------------### -$e = &validate($form, { +$e = validate($form, { bar => { untaint => 1, }, }); -print_ok($e); +ok($e); #print $e if $e; -print_ok(is_tainted($form->{bar})); +ok(is_tainted($form->{bar})); ###----------------------------------------------------------------### -print_ok(!is_tainted($form->{foo})); -print_ok( is_tainted($form->{bar})); -print_ok(!is_tainted($form->{baz})); +ok(!is_tainted($form->{foo})); +ok( is_tainted($form->{bar})); +ok(!is_tainted($form->{baz})); + +} -__DATA__