How do I use File::Find::Rule in taint mode?

Question

I am trying to get a list of subdirectories in a given directory using something like the following:

#!/usr/bin/perl -wT
use strict;
use warnings;

use File::Find::Rule;
use Data::Dumper;

my @subdirs = File::Find::Rule->maxdepth(1)->directory->relative->in('mydir');

print Dumper(@subdirs);

However, running this gives the result:

Insecure dependency in chdir while running with -T switch

I understand that File::Find has options for dealing with taint mode, but I can’t seem to find an equivalent in File::Find::Rule. Is it possible to do the above? Should I use an alternative method for listing subdirectories? Am I completely misunderstanding something obvious that I really should understand about taint mode?

Answer 1

(Edit!) Okay, logic would suggest that throwing in the following would work:

->extras( {untaint => 1, untaint_pattern => $untaint_pattern, untaint_skip => 1} )

This lets you use the taint-mode features of File::Find by passing arguments directly to that module's find() function. Incidentally, File::Find mentions that one should set $untaint_pattern by using the qr// operator. For example, the default value is

$untaint_pattern = qr|^([-+@\w./]+)$|

However, this does not work! In fact, your issue is a known bug in File::Find::Rule. (For example, here are the CPAN and Debian bug reports.) If you would like a bugfix, then both of those bug reports have patches.

If you are in a restricted environment, one thing you can do is essentially implement the patch yourself in your code. For example, if you want to keep everything in one file, you can add the large code block below after use File::Find::Rule. Note that this is a very quick fix and may be suboptimal. If it doesn't work for you (e.g., because you have spaces in your filenames), change the pattern qr|^([-+@\w./]+)$| that is used.

Note finally that if you want your code organization to be a bit better, you may want to dump this into a separate package, maybe called MyFileFindRuleFix or something, that you always use after File::Find::Rule itself.

package File::Find::Rule;
no warnings qw(redefine);
sub in {
    my $self = _force_object shift;

    my @found;
    my $fragment = $self->_compile( $self->{subs} );
    my @subs = @{ $self->{subs} };

    warn "relative mode handed multiple paths - that's a bit silly\n"
      if $self->{relative} && @_ > 1;

    my $topdir;
    my $code = 'sub {
        (my $path = $File::Find::name)  =~ s#^(?:\./+)+##;
        $path = "." if ($path eq ""); # See Debian bug #329377
        my @args = ($_, $File::Find::dir, $path);
        my $maxdepth = $self->{maxdepth};
        my $mindepth = $self->{mindepth};
        my $relative = $self->{relative};

        # figure out the relative path and depth
        my $relpath = $File::Find::name;
        $relpath =~ s{^\Q$topdir\E/?}{};
        my $depth = scalar File::Spec->splitdir($relpath);
        #print "name: \'$File::Find::name\' ";
        #print "relpath: \'$relpath\' depth: $depth relative: $relative\n";

        defined $maxdepth && $depth >= $maxdepth
           and $File::Find::prune = 1;

        defined $mindepth && $depth < $mindepth
           and return;

        #print "Testing \'$_\'\n";

        my $discarded;
        return unless ' . $fragment . ';
        return if $discarded;
        if ($relative) {
            push @found, $relpath if $relpath ne "";
        }
        else {
            push @found, $path;
        }
    }';

    #use Data::Dumper;
    #print Dumper \@subs;
    #warn "Compiled sub: '$code'\n";

    my $sub = eval "$code" or die "compile error '$code' $@";
    my $cwd = getcwd;
    # Untaint it
    if ( $cwd =~ qr|^([-+@\w./]+)$| ) {
        $cwd = $1;
    } else {
        die "Couldn't untaint \$cwd: [$cwd]";
    }
    for my $path (@_) {
        # $topdir is used for relative and maxdepth
        $topdir = $path;
        # slice off the trailing slash if there is one (the
        # maxdepth/mindepth code is fussy)
        $topdir =~ s{/?$}{}
          unless $topdir eq '/';
        $self->_call_find( { %{ $self->{extras} }, wanted => $sub }, $path );
    }
    chdir $cwd;

    return @found;
}
use warnings;
package main;