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