Dogcows Code - chaz/p5-CGI-Ex/blob - t/1_validate_14_untaint.t

   1 #!perl -T
   2 # -*- Mode: Perl; -*-
   3
   4 use strict;
   5
   6 $^W = 1;
   7
   8 ### Set up taint checking
   9 sub is_tainted { local $^W = 0; ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 } }
  10
  11 my $taint = join(",", $0, %ENV, @ARGV);
  12 if (! is_tainted($taint) && open(my $fh, "/dev/urandom")) {
  13   sysread($fh, $taint, 1);
  14 }
  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";
  18   exit;
  19 }
  20
  21 ### make sure tainted hash values don't bleed into other values
  22 my $form = {};
  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";
  30   exit;
  31 }
  32
  33 ###----------------------------------------------------------------###
  34 ### Looks good - here we go
  35
  36 ### determine number of tests
  37 seek(DATA,0,0);
  38 my $prog  = join "", <DATA>;
  39 my @tests = ($prog =~ /print_ok\(/g);
  40 my $tests = @tests;
  41 print "1..$tests\n";
  42
  43 require CGI::Ex::Validate;
  44
  45 my ($N, $v, $e, $ok) = (0);
  46
  47
  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'}));
  52
  53 sub validate {
  54   return scalar &CGI::Ex::Validate::validate(@_);
  55 }
  56 sub print_ok {
  57   my $ok = shift;
  58   $N ++;
  59   warn "Test failed at line ".(caller)[2]."\n" if ! $ok;
  60   print "" . ($ok ? "" : "not ") . "ok $N\n";
  61 }
  62 &print_ok(1);
  63
  64 ###----------------------------------------------------------------###
  65
  66 $e = &validate($form, {
  67   foo => {
  68     match   => 'm/^\d+$/',
  69     untaint => 1,
  70   },
  71 });
  72
  73 print_ok(! $e);
  74 print_ok(! is_tainted($form->{foo}));
  75
  76 ###----------------------------------------------------------------###
  77
  78 $e = &validate($form, {
  79   bar => {
  80     match   => 'm/^\d+$/',
  81   },
  82 });
  83
  84 print_ok(! $e);
  85 print_ok(is_tainted($form->{bar}));
  86
  87 ###----------------------------------------------------------------###
  88
  89 $e = &validate($form, {
  90   bar => {
  91     untaint => 1,
  92   },
  93 });
  94
  95 print_ok($e);
  96 #print $e if $e;
  97 print_ok(is_tainted($form->{bar}));
  98
  99 ###----------------------------------------------------------------###
 100
 101 print_ok(!is_tainted($form->{foo}));
 102 print_ok( is_tainted($form->{bar}));
 103 print_ok(!is_tainted($form->{baz}));
 104
 105 __DATA__