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