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 = 0; ! eval { eval("#" . substr(join("", @_), 0, 0)); 1; 0 } }
  17
  18 SKIP: {
  19
  20 my $taint = join(",", $0, %ENV, @ARGV);
  21 if (! is_tainted($taint) && open(my $fh, "/dev/urandom")) {
  22   sysread($fh, $taint, 1);
  23 }
  24 $taint = substr($taint, 0, 0);
  25 if (! is_tainted($taint)) {
  26     skip("is_tainted doesn't appear to work", 14);
  27 }
  28
  29 ### make sure tainted hash values don't bleed into other values
  30 my $form = {};
  31 $form->{'foo'} = "123$taint";
  32 $form->{'bar'} = "456$taint";
  33 $form->{'baz'} = "789";
  34 if (!  is_tainted($form->{'foo'})) {
  35     skip("Tainted hash key didn't work right", 14);
  36 } elsif (is_tainted($form->{'baz'})) {
  37     # untaint checking doesn't really work
  38     skip("Hashes with mixed taint don't work right", 14);
  39 }
  40
  41 ###----------------------------------------------------------------###
  42 ### Looks good - here we go
  43
  44 use_ok('CGI::Ex::Validate');
  45
  46 my $e;
  47
  48 ok(is_tainted($taint));
  49 ok(is_tainted($form->{'foo'}));
  50 ok(! is_tainted($form->{'baz'}));
  51 ok(! is_tainted($form->{'non_existent_key'}));
  52
  53 sub validate { scalar CGI::Ex::Validate::validate(@_) }
  54
  55
  56 ###----------------------------------------------------------------###
  57
  58 $e = validate($form, {
  59   foo => {
  60     match   => 'm/^\d+$/',
  61     untaint => 1,
  62   },
  63 });
  64
  65 ok(! $e);
  66 ok(! is_tainted($form->{foo}));
  67
  68 ###----------------------------------------------------------------###
  69
  70 $e = validate($form, {
  71   bar => {
  72     match   => 'm/^\d+$/',
  73   },
  74 });
  75
  76 ok(! $e);
  77 ok(is_tainted($form->{bar}));
  78
  79 ###----------------------------------------------------------------###
  80
  81 $e = validate($form, {
  82   bar => {
  83     untaint => 1,
  84   },
  85 });
  86
  87 ok($e);
  88 #print $e if $e;
  89 ok(is_tainted($form->{bar}));
  90
  91 ###----------------------------------------------------------------###
  92
  93 ok(!is_tainted($form->{foo}));
  94 ok( is_tainted($form->{bar}));
  95 ok(!is_tainted($form->{baz}));
  96
  97 }
  98