external/perl/Text-Template-1.56/t/taint.t

   1 #!perl -T
   2 # Tests for taint-mode features
   3
   4 use strict;
   5 use warnings;
   6 use lib 'blib/lib';
   7 use Test::More tests => 21;
   8 use File::Temp;
   9
  10 use_ok 'Text::Template' or exit 1;
  11
  12 if ($^O eq 'MSWin32') {
  13     # File::Temp (for all versions up to at least 0.2308) is currently bugged under MSWin32/taint mode [as of 2018-09]
  14     # ... fails unless "/tmp" on the current windows drive is a writable directory OR either $ENV{TMP} or $ENV{TEMP} are untainted and point to a writable directory
  15     # ref: [File-Temp: Fails under -T, Windows 7, Strawberry Perl 5.12.1](https://rt.cpan.org/Public/Bug/Display.html?id=60340)
  16     ($ENV{TEMP}) = $ENV{TEMP} =~ m/^.*$/gmsx; # untaint $ENV{TEMP}
  17     ($ENV{TMP})  = $ENV{TMP}  =~ m/^.*$/gmsx; # untaint $ENV{TMP}
  18 }
  19
  20 my $tmpfile = File::Temp->new;
  21 my $file    = $tmpfile->filename;
  22
  23 # makes its arguments tainted
  24 sub taint {
  25     for (@_) {
  26         $_ .= substr($0, 0, 0);    # LOD
  27     }
  28 }
  29
  30 my $template = 'The value of $n is {$n}.';
  31
  32 open my $fh, '>', $file or die "Couldn't write temporary file $file: $!";
  33 print $fh $template, "\n";
  34 close $fh or die "Couldn't finish temporary file $file: $!";
  35
  36 sub should_fail {
  37     my $obj = Text::Template->new(@_);
  38     eval { $obj->fill_in() };
  39     if ($@) {
  40         pass $@;
  41     }
  42     else {
  43         fail q[didn't fail];
  44     }
  45 }
  46
  47 sub should_work {
  48     my $obj = Text::Template->new(@_);
  49     eval { $obj->fill_in() };
  50     if ($@) {
  51         fail $@;
  52     }
  53     else {
  54         pass;
  55     }
  56 }
  57
  58 sub should_be_tainted {
  59     ok !Text::Template::_is_clean($_[0]);
  60 }
  61
  62 sub should_be_clean {
  63     ok Text::Template::_is_clean($_[0]);
  64 }
  65
  66 # Tainted filename should die with and without UNTAINT option
  67 # untainted filename should die without UNTAINT option
  68 # filehandle should die without UNTAINT option
  69 # string and array with tainted data should die either way
  70
  71 # (2)-(7)
  72 my $tfile = $file;
  73 taint($tfile);
  74 should_be_tainted($tfile);
  75 should_be_clean($file);
  76 should_fail TYPE => 'file', SOURCE => $tfile;
  77 should_fail TYPE => 'file', SOURCE => $tfile, UNTAINT => 1;
  78 should_fail TYPE => 'file', SOURCE => $file;
  79 should_work TYPE => 'file', SOURCE => $file, UNTAINT => 1;
  80
  81 # (8-9)
  82 open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting";
  83 should_fail TYPE => 'filehandle', SOURCE => $fh;
  84 close $fh;
  85
  86 open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting";
  87 should_work TYPE => 'filehandle', SOURCE => $fh, UNTAINT => 1;
  88 close $fh;
  89
  90 # (10-15)
  91 my $ttemplate = $template;
  92 taint($ttemplate);
  93 should_be_tainted($ttemplate);
  94 should_be_clean($template);
  95 should_fail TYPE => 'string', SOURCE => $ttemplate;
  96 should_fail TYPE => 'string', SOURCE => $ttemplate, UNTAINT => 1;
  97 should_work TYPE => 'string', SOURCE => $template;
  98 should_work TYPE => 'string', SOURCE => $template, UNTAINT => 1;
  99
 100 # (16-19)
 101 my $array  = [$template];
 102 my $tarray = [$ttemplate];
 103 should_fail TYPE => 'array', SOURCE => $tarray;
 104 should_fail TYPE => 'array', SOURCE => $tarray, UNTAINT => 1;
 105 should_work TYPE => 'array', SOURCE => $array;
 106 should_work TYPE => 'array', SOURCE => $array, UNTAINT => 1;
 107
 108 # (20-21) Test _unconditionally_untaint utility function
 109 Text::Template::_unconditionally_untaint($ttemplate);
 110 should_be_clean($ttemplate);
 111 Text::Template::_unconditionally_untaint($tfile);
 112 should_be_clean($tfile);