lib/openssl/external/perl/Text-Template-1.46/t/13-taint.t

   1 #!perl -T
   2 # Tests for taint-mode features
   3
   4 use lib 'blib/lib';
   5 use Text::Template;
   6
   7 die "This is the test program for Text::Template version 1.46.
   8 You are using version $Text::Template::VERSION instead.
   9 That does not make sense.\n
  10 Aborting"
  11   unless $Text::Template::VERSION == 1.46;
  12
  13 my $r = int(rand(10000));
  14 my $file = "tt$r";
  15
  16 # makes its arguments tainted
  17 sub taint {
  18   for (@_) {
  19     $_ .= substr($0,0,0);       # LOD
  20   }
  21 }
  22
  23
  24 print "1..21\n";
  25
  26 my $n =1;
  27 print "ok ", $n++, "\n";
  28
  29 my $template = 'The value of $n is {$n}.';
  30
  31 open T, "> $file" or die "Couldn't write temporary file $file: $!";
  32 print T $template, "\n";
  33 close T or die "Couldn't finish temporary file $file: $!";
  34
  35 sub should_fail {
  36   my $obj = Text::Template->new(@_);
  37   eval {$obj->fill_in()};
  38   if ($@) {
  39     print "ok $n # $@\n";
  40   } else {
  41     print "not ok $n # (didn't fail)\n";
  42   }
  43   $n++;
  44 }
  45
  46 sub should_work {
  47   my $obj = Text::Template->new(@_);
  48   eval {$obj->fill_in()};
  49   if ($@) {
  50     print "not ok $n # $@\n";
  51   } else {
  52     print "ok $n\n";
  53   }
  54   $n++;
  55 }
  56
  57 sub should_be_tainted {
  58   if (Text::Template::_is_clean($_[0])) {
  59     print "not ok $n\n"; $n++; return;
  60   }
  61   print "ok $n\n"; $n++; return;
  62 }
  63
  64 sub should_be_clean {
  65   unless (Text::Template::_is_clean($_[0])) {
  66     print "not ok $n\n"; $n++; return;
  67   }
  68   print "ok $n\n"; $n++; return;
  69 }
  70
  71 # Tainted filename should die with and without UNTAINT option
  72 # untainted filename should die without UNTAINT option
  73 # filehandle should die without UNTAINT option
  74 # string and array with tainted data should die either way
  75
  76 # (2)-(7)
  77 my $tfile = $file;
  78 taint($tfile);
  79 should_be_tainted($tfile);
  80 should_be_clean($file);
  81 should_fail TYPE => 'file', SOURCE => $tfile;
  82 should_fail TYPE => 'file', SOURCE => $tfile, UNTAINT => 1;
  83 should_fail TYPE => 'file', SOURCE => $file;
  84 should_work TYPE => 'file', SOURCE => $file, UNTAINT => 1;
  85
  86 # (8-9)
  87 open H, "< $file" or die "Couldn't open $file for reading: $!; aborting";
  88 should_fail TYPE => 'filehandle', SOURCE => \*H;
  89 close H;
  90 open H, "< $file" or die "Couldn't open $file for reading: $!; aborting";
  91 should_work TYPE => 'filehandle', SOURCE => \*H, UNTAINT => 1;
  92 close H;
  93
  94 # (10-15)
  95 my $ttemplate = $template;
  96 taint($ttemplate);
  97 should_be_tainted($ttemplate);
  98 should_be_clean($template);
  99 should_fail TYPE => 'string', SOURCE => $ttemplate;
 100 should_fail TYPE => 'string', SOURCE => $ttemplate, UNTAINT => 1;
 101 should_work TYPE => 'string', SOURCE => $template;
 102 should_work TYPE => 'string', SOURCE => $template, UNTAINT => 1;
 103
 104 # (16-19)
 105 my $array = [ $template ];
 106 my $tarray = [ $ttemplate ];
 107 should_fail TYPE => 'array', SOURCE => $tarray;
 108 should_fail TYPE => 'array', SOURCE => $tarray, UNTAINT => 1;
 109 should_work TYPE => 'array', SOURCE => $array;
 110 should_work TYPE => 'array', SOURCE => $array, UNTAINT => 1;
 111
 112 # (20-21) Test _unconditionally_untaint utility function
 113 Text::Template::_unconditionally_untaint($ttemplate);
 114 should_be_clean($ttemplate);
 115 Text::Template::_unconditionally_untaint($tfile);
 116 should_be_clean($tfile);
 117
 118 END { unlink $file }
 119