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