• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!perl -T
2# Tests for taint-mode features
3
4use lib 'blib/lib';
5use Text::Template;
6
7die "This is the test program for Text::Template version 1.46.
8You are using version $Text::Template::VERSION instead.
9That does not make sense.\n
10Aborting"
11  unless $Text::Template::VERSION == 1.46;
12
13my $r = int(rand(10000));
14my $file = "tt$r";
15
16# makes its arguments tainted
17sub taint {
18  for (@_) {
19    $_ .= substr($0,0,0);       # LOD
20  }
21}
22
23
24print "1..21\n";
25
26my $n =1;
27print "ok ", $n++, "\n";
28
29my $template = 'The value of $n is {$n}.';
30
31open T, "> $file" or die "Couldn't write temporary file $file: $!";
32print T $template, "\n";
33close T or die "Couldn't finish temporary file $file: $!";
34
35sub should_fail {
36  my $obj = Text::Template->new(@_);
37  eval {$obj->fill_in()};
38  if ($@) {
39    print "ok $n # $@\n";
40  } else {
41    print "not ok $n # (didn't fail)\n";
42  }
43  $n++;
44}
45
46sub should_work {
47  my $obj = Text::Template->new(@_);
48  eval {$obj->fill_in()};
49  if ($@) {
50    print "not ok $n # $@\n";
51  } else {
52    print "ok $n\n";
53  }
54  $n++;
55}
56
57sub should_be_tainted {
58  if (Text::Template::_is_clean($_[0])) {
59    print "not ok $n\n"; $n++; return;
60  }
61  print "ok $n\n"; $n++; return;
62}
63
64sub should_be_clean {
65  unless (Text::Template::_is_clean($_[0])) {
66    print "not ok $n\n"; $n++; return;
67  }
68  print "ok $n\n"; $n++; return;
69}
70
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
75
76# (2)-(7)
77my $tfile = $file;
78taint($tfile);
79should_be_tainted($tfile);
80should_be_clean($file);
81should_fail TYPE => 'file', SOURCE => $tfile;
82should_fail TYPE => 'file', SOURCE => $tfile, UNTAINT => 1;
83should_fail TYPE => 'file', SOURCE => $file;
84should_work TYPE => 'file', SOURCE => $file, UNTAINT => 1;
85
86# (8-9)
87open H, "< $file" or die "Couldn't open $file for reading: $!; aborting";
88should_fail TYPE => 'filehandle', SOURCE => \*H;
89close H;
90open H, "< $file" or die "Couldn't open $file for reading: $!; aborting";
91should_work TYPE => 'filehandle', SOURCE => \*H, UNTAINT => 1;
92close H;
93
94# (10-15)
95my $ttemplate = $template;
96taint($ttemplate);
97should_be_tainted($ttemplate);
98should_be_clean($template);
99should_fail TYPE => 'string', SOURCE => $ttemplate;
100should_fail TYPE => 'string', SOURCE => $ttemplate, UNTAINT => 1;
101should_work TYPE => 'string', SOURCE => $template;
102should_work TYPE => 'string', SOURCE => $template, UNTAINT => 1;
103
104# (16-19)
105my $array = [ $template ];
106my $tarray = [ $ttemplate ];
107should_fail TYPE => 'array', SOURCE => $tarray;
108should_fail TYPE => 'array', SOURCE => $tarray, UNTAINT => 1;
109should_work TYPE => 'array', SOURCE => $array;
110should_work TYPE => 'array', SOURCE => $array, UNTAINT => 1;
111
112# (20-21) Test _unconditionally_untaint utility function
113Text::Template::_unconditionally_untaint($ttemplate);
114should_be_clean($ttemplate);
115Text::Template::_unconditionally_untaint($tfile);
116should_be_clean($tfile);
117
118END { unlink $file }
119
120