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