Commit | Line | Data |
3fa6e24b |
1 | #!./perl -T |
2 | |
3 | |
6455dd3b |
4 | my %Expect_File = (); # what we expect for $_ |
3fa6e24b |
5 | my %Expect_Name = (); # what we expect for $File::Find::name/fullname |
6 | my %Expect_Dir = (); # what we expect for $File::Find::dir |
87ba1cf0 |
7 | my ($cwd, $cwd_untainted); |
3fa6e24b |
8 | |
8ddbe0db |
9 | |
3fa6e24b |
10 | BEGIN { |
11 | chdir 't' if -d 't'; |
12 | unshift @INC => '../lib'; |
88587957 |
13 | } |
14 | |
15 | use Config; |
3fa6e24b |
16 | |
88587957 |
17 | BEGIN { |
fea335d7 |
18 | if ($^O ne 'VMS') { |
19 | for (keys %ENV) { # untaint ENV |
20 | ($ENV{$_}) = $ENV{$_} =~ /(.*)/; |
21 | } |
3fa6e24b |
22 | } |
8ddbe0db |
23 | |
24 | # Remove insecure directories from PATH |
25 | my @path; |
26 | my $sep = $Config{path_sep}; |
27 | foreach my $dir (split(/\Q$sep/,$ENV{'PATH'})) |
28 | { |
29 | ## |
30 | ## Match the directory taint tests in mg.c::Perl_magic_setenv() |
31 | ## |
32 | push(@path,$dir) unless (length($dir) >= 256 |
33 | or |
34 | substr($dir,0,1) ne "/" |
35 | or |
36 | (stat $dir)[2] & 002); |
37 | } |
38 | $ENV{'PATH'} = join($sep,@path); |
3fa6e24b |
39 | } |
40 | |
87ba1cf0 |
41 | use Test::More tests => 45; |
004cc508 |
42 | |
87ba1cf0 |
43 | my $symlink_exists = eval { symlink("",""); 1 }; |
3fa6e24b |
44 | |
45 | use File::Find; |
46 | use File::Spec; |
47 | use Cwd; |
a1b073b7 |
48 | |
3fa6e24b |
49 | cleanup(); |
50 | |
87ba1cf0 |
51 | my $found; |
49293501 |
52 | find({wanted => sub { $found = 1 if ($_ eq '1_compile.t') }, |
87ba1cf0 |
53 | untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); |
6455dd3b |
54 | |
49293501 |
55 | ok($found, '1_compile.t found'); |
87ba1cf0 |
56 | $found = 0; |
6455dd3b |
57 | |
49293501 |
58 | finddepth({wanted => sub { $found = 1 if $_ eq '1_compile.t'; }, |
87ba1cf0 |
59 | untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir); |
6455dd3b |
60 | |
49293501 |
61 | ok($found, '1_compile.t found again'); |
3fa6e24b |
62 | |
63 | my $case = 2; |
64 | my $FastFileTests_OK = 0; |
65 | |
66 | sub cleanup { |
67 | if (-d dir_path('for_find')) { |
68 | chdir(dir_path('for_find')); |
6fecce66 |
69 | } |
70 | if (-d dir_path('fa')) { |
71 | unlink file_path('fa', 'fa_ord'), |
72 | file_path('fa', 'fsl'), |
73 | file_path('fa', 'faa', 'faa_ord'), |
74 | file_path('fa', 'fab', 'fab_ord'), |
75 | file_path('fa', 'fab', 'faba', 'faba_ord'), |
76 | file_path('fb', 'fb_ord'), |
77 | file_path('fb', 'fba', 'fba_ord'); |
78 | rmdir dir_path('fa', 'faa'); |
79 | rmdir dir_path('fa', 'fab', 'faba'); |
80 | rmdir dir_path('fa', 'fab'); |
81 | rmdir dir_path('fa'); |
82 | rmdir dir_path('fb', 'fba'); |
83 | rmdir dir_path('fb'); |
84 | } |
85 | chdir File::Spec->updir; |
86 | if (-d dir_path('for_find')) { |
87 | rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n"; |
3fa6e24b |
88 | } |
89 | } |
90 | |
91 | END { |
92 | cleanup(); |
93 | } |
94 | |
3fa6e24b |
95 | sub touch { |
87ba1cf0 |
96 | ok( open(my $T,'>',$_[0]), "Opened $_[0] successfully" ); |
3fa6e24b |
97 | } |
98 | |
99 | sub MkDir($$) { |
87ba1cf0 |
100 | ok( mkdir($_[0],$_[1]), "Created directory $_[0] successfully" ); |
3fa6e24b |
101 | } |
102 | |
103 | sub wanted_File_Dir { |
104 | print "# \$File::Find::dir => '$File::Find::dir'\n"; |
105 | print "# \$_ => '$_'\n"; |
106 | s#\.$## if ($^O eq 'VMS' && $_ ne '.'); |
87ba1cf0 |
107 | ok( $Expect_File{$_}, "Expected and found $File::Find::name" ); |
3fa6e24b |
108 | if ( $FastFileTests_OK ) { |
6455dd3b |
109 | delete $Expect_File{ $_} |
3fa6e24b |
110 | unless ( $Expect_Dir{$_} && ! -d _ ); |
111 | } else { |
6455dd3b |
112 | delete $Expect_File{$_} |
3fa6e24b |
113 | unless ( $Expect_Dir{$_} && ! -d $_ ); |
114 | } |
115 | } |
116 | |
117 | sub wanted_File_Dir_prune { |
118 | &wanted_File_Dir; |
119 | $File::Find::prune=1 if $_ eq 'faba'; |
120 | } |
121 | |
3fa6e24b |
122 | sub simple_wanted { |
123 | print "# \$File::Find::dir => '$File::Find::dir'\n"; |
124 | print "# \$_ => '$_'\n"; |
125 | } |
126 | |
127 | |
bb7dc48b |
128 | # Use dir_path() to specify a directory path that's expected for |
129 | # $File::Find::dir (%Expect_Dir). Also use it in file operations like |
130 | # chdir, rmdir etc. |
3fa6e24b |
131 | # |
2586ba89 |
132 | # dir_path() concatenates directory names to form a *relative* |
133 | # directory path, independent from the platform it's run on, although |
134 | # there are limitations. Don't try to create an absolute path, |
bb7dc48b |
135 | # because that may fail on operating systems that have the concept of |
6455dd3b |
136 | # volume names (e.g. Mac OS). As a special case, you can pass it a "." |
2586ba89 |
137 | # as first argument, to create a directory path like "./fa/dir" on |
bb7dc48b |
138 | # operating systems other than Mac OS (actually, Mac OS will ignore |
139 | # the ".", if it's the first argument). If there's no second argument, |
140 | # this function will return the empty string on Mac OS and the string |
141 | # "./" otherwise. |
3fa6e24b |
142 | |
143 | sub dir_path { |
2586ba89 |
144 | my $first_arg = shift @_; |
3fa6e24b |
145 | |
2586ba89 |
146 | if ($first_arg eq '.') { |
3fa6e24b |
147 | if ($^O eq 'MacOS') { |
148 | return '' unless @_; |
149 | # ignore first argument; return a relative path |
150 | # with leading ":" and with trailing ":" |
6455dd3b |
151 | return File::Spec->catdir(@_); |
3fa6e24b |
152 | } else { # other OS |
153 | return './' unless @_; |
154 | my $path = File::Spec->catdir(@_); |
155 | # add leading "./" |
156 | $path = "./$path"; |
157 | return $path; |
158 | } |
159 | |
2586ba89 |
160 | } else { # $first_arg ne '.' |
161 | return $first_arg unless @_; # return plain filename |
162 | return File::Spec->catdir($first_arg, @_); # relative path |
3fa6e24b |
163 | } |
164 | } |
165 | |
166 | |
bb7dc48b |
167 | # Use topdir() to specify a directory path that you want to pass to |
2586ba89 |
168 | # find/finddepth. Basically, topdir() does the same as dir_path() (see |
169 | # above), except that there's no trailing ":" on Mac OS. |
3fa6e24b |
170 | |
171 | sub topdir { |
172 | my $path = dir_path(@_); |
173 | $path =~ s/:$// if ($^O eq 'MacOS'); |
174 | return $path; |
175 | } |
176 | |
177 | |
2586ba89 |
178 | # Use file_path() to specify a file path that's expected for $_ |
179 | # (%Expect_File). Also suitable for file operations like unlink etc. |
180 | # |
bb7dc48b |
181 | # file_path() concatenates directory names (if any) and a filename to |
2586ba89 |
182 | # form a *relative* file path (the last argument is assumed to be a |
183 | # file). It's independent from the platform it's run on, although |
6455dd3b |
184 | # there are limitations. As a special case, you can pass it a "." as |
185 | # first argument, to create a file path like "./fa/file" on operating |
186 | # systems other than Mac OS (actually, Mac OS will ignore the ".", if |
187 | # it's the first argument). If there's no second argument, this |
188 | # function will return the empty string on Mac OS and the string "./" |
2586ba89 |
189 | # otherwise. |
3fa6e24b |
190 | |
191 | sub file_path { |
2586ba89 |
192 | my $first_arg = shift @_; |
3fa6e24b |
193 | |
2586ba89 |
194 | if ($first_arg eq '.') { |
3fa6e24b |
195 | if ($^O eq 'MacOS') { |
196 | return '' unless @_; |
6455dd3b |
197 | # ignore first argument; return a relative path |
3fa6e24b |
198 | # with leading ":", but without trailing ":" |
6455dd3b |
199 | return File::Spec->catfile(@_); |
3fa6e24b |
200 | } else { # other OS |
201 | return './' unless @_; |
202 | my $path = File::Spec->catfile(@_); |
6455dd3b |
203 | # add leading "./" |
204 | $path = "./$path"; |
3fa6e24b |
205 | return $path; |
206 | } |
207 | |
2586ba89 |
208 | } else { # $first_arg ne '.' |
209 | return $first_arg unless @_; # return plain filename |
210 | return File::Spec->catfile($first_arg, @_); # relative path |
3fa6e24b |
211 | } |
212 | } |
213 | |
214 | |
bb7dc48b |
215 | # Use file_path_name() to specify a file path that's expected for |
216 | # $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1 |
217 | # option is in effect, $_ is the same as $File::Find::Name. In that |
218 | # case, also use this function to specify a file path that's expected |
219 | # for $_. |
3fa6e24b |
220 | # |
bb7dc48b |
221 | # Basically, file_path_name() does the same as file_path() (see |
222 | # above), except that there's always a leading ":" on Mac OS, even for |
223 | # plain file/directory names. |
3fa6e24b |
224 | |
225 | sub file_path_name { |
226 | my $path = file_path(@_); |
227 | $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/)); |
228 | return $path; |
229 | } |
230 | |
231 | |
36841713 |
232 | MkDir( dir_path('for_find'), 0770 ); |
87ba1cf0 |
233 | ok( chdir( dir_path('for_find')), 'successful chdir() to for_find' ); |
3fa6e24b |
234 | |
235 | $cwd = cwd(); # save cwd |
236 | ( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it |
237 | |
238 | MkDir( dir_path('fa'), 0770 ); |
239 | MkDir( dir_path('fb'), 0770 ); |
240 | touch( file_path('fb', 'fb_ord') ); |
241 | MkDir( dir_path('fb', 'fba'), 0770 ); |
242 | touch( file_path('fb', 'fba', 'fba_ord') ); |
87ba1cf0 |
243 | SKIP: { |
244 | skip "Creating symlink", 1, unless $symlink_exists; |
3fa6e24b |
245 | if ($^O eq 'MacOS') { |
87ba1cf0 |
246 | ok( symlink(':fb',':fa:fsl'), 'Created symbolic link' ); |
3fa6e24b |
247 | } else { |
87ba1cf0 |
248 | ok( symlink('../fb','fa/fsl'), 'Created symbolic link' ); |
249 | } |
3fa6e24b |
250 | } |
251 | touch( file_path('fa', 'fa_ord') ); |
252 | |
253 | MkDir( dir_path('fa', 'faa'), 0770 ); |
254 | touch( file_path('fa', 'faa', 'faa_ord') ); |
255 | MkDir( dir_path('fa', 'fab'), 0770 ); |
256 | touch( file_path('fa', 'fab', 'fab_ord') ); |
257 | MkDir( dir_path('fa', 'fab', 'faba'), 0770 ); |
258 | touch( file_path('fa', 'fab', 'faba', 'faba_ord') ); |
259 | |
3fa6e24b |
260 | print "# check untainting (no follow)\n"; |
261 | |
262 | # untainting here should work correctly |
bb7dc48b |
263 | |
264 | %Expect_File = (File::Spec->curdir => 1, file_path('fsl') => |
265 | 1,file_path('fa_ord') => 1, file_path('fab') => 1, |
266 | file_path('fab_ord') => 1, file_path('faba') => 1, |
3fa6e24b |
267 | file_path('faa') => 1, file_path('faa_ord') => 1); |
268 | delete $Expect_File{ file_path('fsl') } unless $symlink_exists; |
269 | %Expect_Name = (); |
bb7dc48b |
270 | |
271 | %Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1, |
272 | dir_path('fab') => 1, dir_path('faba') => 1, |
3fa6e24b |
273 | dir_path('fb') => 1, dir_path('fba') => 1); |
bb7dc48b |
274 | |
3fa6e24b |
275 | delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists; |
bb7dc48b |
276 | |
277 | File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1, |
278 | untaint_pattern => qr|^(.+)$|}, topdir('fa') ); |
279 | |
87ba1cf0 |
280 | is(scalar keys %Expect_File, 0, 'Found all expected files'); |
3fa6e24b |
281 | |
282 | |
283 | # don't untaint at all, should die |
284 | %Expect_File = (); |
285 | %Expect_Name = (); |
286 | %Expect_Dir = (); |
287 | undef $@; |
288 | eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );}; |
87ba1cf0 |
289 | like( $@, qr|Insecure dependency|, 'Tainted directory causes death (good)' ); |
3fa6e24b |
290 | chdir($cwd_untainted); |
291 | |
292 | |
6455dd3b |
293 | # untaint pattern doesn't match, should die |
3fa6e24b |
294 | undef $@; |
bb7dc48b |
295 | |
3fa6e24b |
296 | eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, |
bb7dc48b |
297 | untaint_pattern => qr|^(NO_MATCH)$|}, |
298 | topdir('fa') );}; |
299 | |
87ba1cf0 |
300 | like( $@, qr|is still tainted|, 'Bad untaint pattern causes death (good)' ); |
3fa6e24b |
301 | chdir($cwd_untainted); |
302 | |
303 | |
6455dd3b |
304 | # untaint pattern doesn't match, should die when we chdir to cwd |
004cc508 |
305 | print "# check untaint_skip (No follow)\n"; |
3fa6e24b |
306 | undef $@; |
bb7dc48b |
307 | |
308 | eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, |
309 | untaint_skip => 1, untaint_pattern => |
310 | qr|^(NO_MATCH)$|}, topdir('fa') );}; |
311 | |
004cc508 |
312 | print "# $@" if $@; |
313 | #$^D = 8; |
87ba1cf0 |
314 | like( $@, qr|insecure cwd|, 'Bad untaint pattern causes death in cwd (good)' ); |
6455dd3b |
315 | |
3fa6e24b |
316 | chdir($cwd_untainted); |
317 | |
318 | |
87ba1cf0 |
319 | SKIP: { |
320 | skip "Symbolic link tests", 17, unless $symlink_exists; |
bb7dc48b |
321 | print "# --- symbolic link tests --- \n"; |
3fa6e24b |
322 | $FastFileTests_OK= 1; |
323 | |
324 | print "# check untainting (follow)\n"; |
325 | |
326 | # untainting here should work correctly |
327 | # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File |
bb7dc48b |
328 | |
329 | %Expect_File = (file_path_name('fa') => 1, |
330 | file_path_name('fa','fa_ord') => 1, |
331 | file_path_name('fa', 'fsl') => 1, |
332 | file_path_name('fa', 'fsl', 'fb_ord') => 1, |
333 | file_path_name('fa', 'fsl', 'fba') => 1, |
334 | file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1, |
335 | file_path_name('fa', 'fab') => 1, |
336 | file_path_name('fa', 'fab', 'fab_ord') => 1, |
337 | file_path_name('fa', 'fab', 'faba') => 1, |
338 | file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1, |
339 | file_path_name('fa', 'faa') => 1, |
340 | file_path_name('fa', 'faa', 'faa_ord') => 1); |
341 | |
3fa6e24b |
342 | %Expect_Name = (); |
bb7dc48b |
343 | |
344 | %Expect_Dir = (dir_path('fa') => 1, |
345 | dir_path('fa', 'faa') => 1, |
346 | dir_path('fa', 'fab') => 1, |
347 | dir_path('fa', 'fab', 'faba') => 1, |
348 | dir_path('fb') => 1, |
349 | dir_path('fb', 'fba') => 1); |
350 | |
351 | File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1, |
352 | no_chdir => 1, untaint => 1, untaint_pattern => |
353 | qr|^(.+)$| }, topdir('fa') ); |
354 | |
87ba1cf0 |
355 | is( scalar(keys %Expect_File), 0, 'Found all files in symlink test' ); |
6455dd3b |
356 | |
357 | |
3fa6e24b |
358 | # don't untaint at all, should die |
359 | undef $@; |
bb7dc48b |
360 | |
361 | eval {File::Find::find( {wanted => \&simple_wanted, follow => 1}, |
362 | topdir('fa') );}; |
363 | |
87ba1cf0 |
364 | like( $@, qr|Insecure dependency|, 'Not untainting causes death (good)' ); |
3fa6e24b |
365 | chdir($cwd_untainted); |
366 | |
367 | # untaint pattern doesn't match, should die |
368 | undef $@; |
bb7dc48b |
369 | |
370 | eval {File::Find::find( {wanted => \&simple_wanted, follow => 1, |
371 | untaint => 1, untaint_pattern => |
372 | qr|^(NO_MATCH)$|}, topdir('fa') );}; |
373 | |
87ba1cf0 |
374 | like( $@, qr|is still tainted|, 'Bat untaint pattern causes death (good)' ); |
3fa6e24b |
375 | chdir($cwd_untainted); |
376 | |
377 | # untaint pattern doesn't match, should die when we chdir to cwd |
004cc508 |
378 | print "# check untaint_skip (Follow)\n"; |
3fa6e24b |
379 | undef $@; |
bb7dc48b |
380 | |
381 | eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1, |
382 | untaint_skip => 1, untaint_pattern => |
383 | qr|^(NO_MATCH)$|}, topdir('fa') );}; |
87ba1cf0 |
384 | like( $@, qr|insecure cwd|, 'Cwd not untainted with bad pattern (good)' ); |
30c4d17d |
385 | |
3fa6e24b |
386 | chdir($cwd_untainted); |
6455dd3b |
387 | } |