1#!perl -T 2# Tests for taint-mode features 3 4use strict; 5use warnings; 6use lib 'blib/lib'; 7use Test::More tests => 21; 8use File::Temp; 9 10use_ok 'Text::Template' or exit 1; 11 12if ($^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 20my $tmpfile = File::Temp->new; 21my $file = $tmpfile->filename; 22 23# makes its arguments tainted 24sub taint { 25 for (@_) { 26 $_ .= substr($0, 0, 0); # LOD 27 } 28} 29 30my $template = 'The value of $n is {$n}.'; 31 32open my $fh, '>', $file or die "Couldn't write temporary file $file: $!"; 33print $fh $template, "\n"; 34close $fh or die "Couldn't finish temporary file $file: $!"; 35 36sub 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 47sub 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 58sub should_be_tainted { 59 ok !Text::Template::_is_clean($_[0]); 60} 61 62sub 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) 72my $tfile = $file; 73taint($tfile); 74should_be_tainted($tfile); 75should_be_clean($file); 76should_fail TYPE => 'file', SOURCE => $tfile; 77should_fail TYPE => 'file', SOURCE => $tfile, UNTAINT => 1; 78should_fail TYPE => 'file', SOURCE => $file; 79should_work TYPE => 'file', SOURCE => $file, UNTAINT => 1; 80 81# (8-9) 82open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting"; 83should_fail TYPE => 'filehandle', SOURCE => $fh; 84close $fh; 85 86open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting"; 87should_work TYPE => 'filehandle', SOURCE => $fh, UNTAINT => 1; 88close $fh; 89 90# (10-15) 91my $ttemplate = $template; 92taint($ttemplate); 93should_be_tainted($ttemplate); 94should_be_clean($template); 95should_fail TYPE => 'string', SOURCE => $ttemplate; 96should_fail TYPE => 'string', SOURCE => $ttemplate, UNTAINT => 1; 97should_work TYPE => 'string', SOURCE => $template; 98should_work TYPE => 'string', SOURCE => $template, UNTAINT => 1; 99 100# (16-19) 101my $array = [$template]; 102my $tarray = [$ttemplate]; 103should_fail TYPE => 'array', SOURCE => $tarray; 104should_fail TYPE => 'array', SOURCE => $tarray, UNTAINT => 1; 105should_work TYPE => 'array', SOURCE => $array; 106should_work TYPE => 'array', SOURCE => $array, UNTAINT => 1; 107 108# (20-21) Test _unconditionally_untaint utility function 109Text::Template::_unconditionally_untaint($ttemplate); 110should_be_clean($ttemplate); 111Text::Template::_unconditionally_untaint($tfile); 112should_be_clean($tfile); 113