2 # Tests for taint-mode features
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
11 unless $Text::Template::VERSION == 1.46;
13 my $r = int(rand(10000));
16 # makes its arguments tainted
19 $_ .= substr($0,0,0); # LOD
27 print "ok ", $n++, "\n";
29 my $template = 'The value of $n is {$n}.';
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: $!";
36 my $obj = Text::Template->new(@_);
37 eval {$obj->fill_in()};
41 print "not ok $n # (didn't fail)\n";
47 my $obj = Text::Template->new(@_);
48 eval {$obj->fill_in()};
50 print "not ok $n # $@\n";
57 sub should_be_tainted {
58 if (Text::Template::_is_clean($_[0])) {
59 print "not ok $n\n"; $n++; return;
61 print "ok $n\n"; $n++; return;
65 unless (Text::Template::_is_clean($_[0])) {
66 print "not ok $n\n"; $n++; return;
68 print "ok $n\n"; $n++; return;
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
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;
87 open H, "< $file" or die "Couldn't open $file for reading: $!; aborting";
88 should_fail TYPE => 'filehandle', SOURCE => \*H;
90 open H, "< $file" or die "Couldn't open $file for reading: $!; aborting";
91 should_work TYPE => 'filehandle', SOURCE => \*H, UNTAINT => 1;
95 my $ttemplate = $template;
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;
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;
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);