8 ### Set up taint checking
9 sub is_tainted { local $^W = 0; ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 } }
11 my $taint = join(",", $0, %ENV, @ARGV);
12 if (! is_tainted($taint) && open(my $fh, "/dev/urandom")) {
13 sysread($fh, $taint, 1);
15 $taint = substr($taint, 0, 0);
16 if (! is_tainted($taint)) {
17 print "1..1\nok 1 # skip Couldn't get any tainted data or we aren't in taint mode\n";
21 ### make sure tainted hash values don't bleed into other values
23 $form->{'foo'} = "123$taint";
24 $form->{'bar'} = "456$taint";
25 $form->{'baz'} = "789";
26 if (! is_tainted($form->{'foo'})
27 || is_tainted($form->{'baz'})) {
28 # untaint checking doesn't really work
29 print "1..1\nok 1 # skip Hashes with mixed taint don't work right (older perls ?)\n";
33 ###----------------------------------------------------------------###
34 ### Looks good - here we go
36 ### determine number of tests
38 my $prog = join "", <DATA>;
39 my @tests = ($prog =~ /print_ok\(/g);
43 require CGI::Ex::Validate;
45 my ($N, $v, $e, $ok) = (0);
48 print_ok(is_tainted($taint));
49 print_ok(is_tainted($form->{'foo'}));
50 print_ok(! is_tainted($form->{'baz'}));
51 print_ok(! is_tainted($form->{'non_existent_key'}));
54 return scalar &CGI::Ex::Validate::validate(@_);
59 warn "Test failed at line ".(caller)[2]."\n" if ! $ok;
60 print "" . ($ok ? "" : "not ") . "ok $N\n";
64 ###----------------------------------------------------------------###
66 $e = &validate($form, {
74 print_ok(! is_tainted($form->{foo}));
76 ###----------------------------------------------------------------###
78 $e = &validate($form, {
85 print_ok(is_tainted($form->{bar}));
87 ###----------------------------------------------------------------###
89 $e = &validate($form, {
97 print_ok(is_tainted($form->{bar}));
99 ###----------------------------------------------------------------###
101 print_ok(!is_tainted($form->{foo}));
102 print_ok( is_tainted($form->{bar}));
103 print_ok(!is_tainted($form->{baz}));