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

   1 #!perl -T
   2 # -*- Mode: Perl; -*-
   3
   4 =head1 NAME
   5
   6 1_validate_14_untaint.t - Test CGI::Ex::Validate's ability to untaint tested fields
   7
   8 =cut
   9
  10 use strict;
  11 use Test::More tests => 14;
  12 use FindBin qw($Bin);
  13 use lib ($Bin =~ /(.+)/ ? "$1/../lib" : ''); # add bin - but untaint it
  14
  15 ### Set up taint checking
  16 sub is_tainted { local $^W; eval { eval("#" . substr(join("", @_), 0, 0)); 1; } ? 0 : 1 }
  17
  18 SKIP: {
  19
  20 my $ok = 1;
  21 if (is_tainted($ok)) {
  22     skip("is_tainted has false positives($@)", 14);
  23 }
  24
  25
  26 my $taint = join(",", $0, %ENV, @ARGV);
  27 if (! is_tainted($taint) && open(my $fh, "/dev/urandom")) {
  28   sysread($fh, $taint, 1);
  29 }
  30 $taint = substr($taint, 0, 0);
  31 if (! is_tainted($taint)) {
  32     skip("is_tainted doesn't appear to work", 14);
  33 }
  34
  35 ### make sure tainted hash values don't bleed into other values
  36 my $form = {};
  37 if (is_tainted($form)) {
  38     skip("Tainted doesn't work", 14);
  39 }
  40 $form->{'foo'} = "123$taint";
  41 $form->{'bar'} = "456$taint";
  42 $form->{'baz'} = "789";
  43 if (! is_tainted($form->{'foo'})) {
  44     skip("Tainted hash key didn't work right", 14);
  45 } elsif (is_tainted($form->{'baz'})) {
  46     # untaint checking doesn't really work
  47     skip("Hashes with mixed taint don't work right", 14);
  48 }
  49
  50 ###----------------------------------------------------------------###
  51 ### Looks good - here we go
  52
  53 use_ok('CGI::Ex::Validate');
  54
  55 my $e;
  56
  57 ok(is_tainted($taint));
  58 ok(is_tainted($form->{'foo'}));
  59 ok(! is_tainted($form->{'baz'}));
  60 ok(! is_tainted($form->{'non_existent_key'}));
  61
  62 sub validate { scalar CGI::Ex::Validate::validate(@_) }
  63
  64
  65 ###----------------------------------------------------------------###
  66
  67 $e = validate($form, {
  68   foo => {
  69     match   => 'm/^\d+$/',
  70     untaint => 1,
  71   },
  72 });
  73
  74 ok(! $e);
  75 ok(! is_tainted($form->{foo}));
  76
  77 ###----------------------------------------------------------------###
  78
  79 $e = validate($form, {
  80   bar => {
  81     match   => 'm/^\d+$/',
  82   },
  83 });
  84
  85 ok(! $e);
  86 ok(is_tainted($form->{bar}));
  87
  88 ###----------------------------------------------------------------###
  89
  90 $e = validate($form, {
  91   bar => {
  92     untaint => 1,
  93   },
  94 });
  95
  96 ok($e);
  97 #print $e if $e;
  98 ok(is_tainted($form->{bar}));
  99
 100 ###----------------------------------------------------------------###
 101
 102 ok(!is_tainted($form->{foo}));
 103 ok( is_tainted($form->{bar}));
 104 ok(!is_tainted($form->{baz}));
 105
 106 }
 107