This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Part Integrate mainline
[perl5.git] / lib / File / Find / taint.t
1 #!./perl -T
2
3
4 my %Expect_File = (); # what we expect for $_ 
5 my %Expect_Name = (); # what we expect for $File::Find::name/fullname
6 my %Expect_Dir  = (); # what we expect for $File::Find::dir
7 my $symlink_exists = eval { symlink("",""); 1 };
8 my $cwd;
9 my $cwd_untainted;
10
11 use Config;
12
13 BEGIN {
14     chdir 't' if -d 't';
15     unshift @INC => '../lib';
16
17     for (keys %ENV) { # untaint ENV
18         ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
19     }
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);
36 }
37
38
39 if ( $symlink_exists ) { print "1..45\n"; }
40 else                   { print "1..27\n";  }
41
42 use File::Find;
43 use File::Spec;
44 use Cwd;
45
46
47 cleanup();
48
49 find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; },
50       untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
51
52 finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; },
53            untaint => 1, untaint_pattern => qr|^(.+)$|},
54            File::Spec->curdir);
55
56 my $case = 2;
57 my $FastFileTests_OK = 0;
58
59 sub 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
82 END {
83     cleanup();
84 }
85
86 sub Check($) {
87     $case++;
88     if ($_[0]) { print "ok $case\n"; }
89     else       { print "not ok $case\n"; }
90
91 }
92
93 sub CheckDie($) {
94     $case++;
95     if ($_[0]) { print "ok $case\n"; }
96     else       { print "not ok $case\n"; exit 0; }
97 }
98
99 sub Skip($) {
100     $case++;
101     print "ok $case # skipped: ",$_[0],"\n"; 
102 }
103
104 sub touch {
105     CheckDie( open(my $T,'>',$_[0]) );
106 }
107
108 sub MkDir($$) {
109     CheckDie( mkdir($_[0],$_[1]) );
110 }
111
112 sub 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
126 sub wanted_File_Dir_prune {
127     &wanted_File_Dir;
128     $File::Find::prune=1 if  $_ eq 'faba';
129 }
130
131
132 sub simple_wanted {
133     print "# \$File::Find::dir => '$File::Find::dir'\n";
134     print "# \$_ => '$_'\n";
135 }
136
137
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.
141 #
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.
154
155 sub 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
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.
187
188 sub 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.
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.
207
208 sub 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
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 $_.
242 #
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.
246
247 sub file_path_name {
248     my $path = file_path(@_);
249     $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
250     return $path;
251 }
252
253
254
255 MkDir( dir_path('for_find'), 0770 );
256 CheckDie(chdir( dir_path('for_find')));
257
258 $cwd = cwd(); # save cwd
259 ( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
260
261 MkDir( dir_path('fa'), 0770 );
262 MkDir( dir_path('fb'), 0770  );
263 touch( file_path('fb', 'fb_ord') );
264 MkDir( dir_path('fb', 'fba'), 0770  );
265 touch( file_path('fb', 'fba', 'fba_ord') );
266 if ($^O eq 'MacOS') {
267       CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
268 } else {
269       CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
270 }
271 touch( file_path('fa', 'fa_ord') );
272
273 MkDir( dir_path('fa', 'faa'), 0770  );
274 touch( file_path('fa', 'faa', 'faa_ord') );
275 MkDir( dir_path('fa', 'fab'), 0770  );
276 touch( file_path('fa', 'fab', 'fab_ord') );
277 MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
278 touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
279
280 print "# check untainting (no follow)\n";
281
282 # untainting here should work correctly
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,
287                 file_path('faa') => 1, file_path('faa_ord') => 1);
288 delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
289 %Expect_Name = ();
290
291 %Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
292                 dir_path('fab') => 1, dir_path('faba') => 1,
293                 dir_path('fb') => 1, dir_path('fba') => 1);
294
295 delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
296
297 File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
298                    untaint_pattern => qr|^(.+)$|}, topdir('fa') );
299
300 Check( scalar(keys %Expect_File) == 0 );
301
302
303 # don't untaint at all, should die
304 %Expect_File = ();
305 %Expect_Name = ();
306 %Expect_Dir  = ();
307 undef $@;
308 eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );};
309 Check( $@ =~ m|Insecure dependency| );
310 chdir($cwd_untainted);
311
312
313 # untaint pattern doesn't match, should die 
314 undef $@;
315
316 eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
317                          untaint_pattern => qr|^(NO_MATCH)$|},
318                          topdir('fa') );};
319
320 Check( $@ =~ m|is still tainted| );
321 chdir($cwd_untainted);
322
323
324 # untaint pattern doesn't match, should die when we chdir to cwd   
325 print "# check untaint_skip (No follow)\n";
326 undef $@;
327
328 eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
329                          untaint_skip => 1, untaint_pattern =>
330                          qr|^(NO_MATCH)$|}, topdir('fa') );};
331
332 print "# $@" if $@;
333 #$^D = 8;
334 Check( $@ =~ m|insecure cwd| );
335
336 chdir($cwd_untainted);
337
338
339 if ( $symlink_exists ) {
340     print "# --- symbolic link tests --- \n";
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
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
361     %Expect_Name = ();
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
374     Check( scalar(keys %Expect_File) == 0 );
375  
376     
377     # don't untaint at all, should die
378     undef $@;
379
380     eval {File::Find::find( {wanted => \&simple_wanted, follow => 1},
381                             topdir('fa') );};
382
383     Check( $@ =~ m|Insecure dependency| );
384     chdir($cwd_untainted);
385
386     # untaint pattern doesn't match, should die
387     undef $@;
388
389     eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
390                              untaint => 1, untaint_pattern =>
391                              qr|^(NO_MATCH)$|}, topdir('fa') );};
392
393     Check( $@ =~ m|is still tainted| );
394     chdir($cwd_untainted);
395
396     # untaint pattern doesn't match, should die when we chdir to cwd
397     print "# check untaint_skip (Follow)\n";
398     undef $@;
399
400     eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
401                              untaint_skip => 1, untaint_pattern =>
402                              qr|^(NO_MATCH)$|}, topdir('fa') );};
403     Check( $@ =~ m|insecure cwd| );
404
405     chdir($cwd_untainted);
406
407