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