Comment utiliser File :: Find :: Rule en mode taint?

Question

J'essaie d'obtenir une liste des sous-répertoires dans un répertoire donné en utilisant quelque chose comme ce qui suit:

#!/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); 

Cependant, l'exécution de ce donne le résultat:

Insecure dependency in chdir while running with -T switch

I comprendre que File::Find a des options pour traiter le mode d'altération, mais je n'arrive pas à trouver un équivalent dans File::Find::Rule. Est-il possible de faire ce qui précède? Dois-je utiliser une méthode alternative pour répertorier les sous-répertoires? Suis-je complètement malentendu quelque chose d'évident que je devrais vraiment comprendre à propos du mode taint?

Answer 1

(! Modifier) D'accord, la logique suggère que jeter dans ce qui suit fonctionnerait:

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

Cela vous permet d'utiliser les fonctions en mode taint de File :: Trouvez en fournissant des arguments directement à cette fonction find() du module. Par ailleurs, File :: Find mentionne qu'il faut définir $untaint_pattern en utilisant l'opérateur qr//. Par exemple, la valeur par défaut est

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

Cependant, cela ne fonctionne pas! En fait, votre problème est un bug connu dans File :: Find :: Rule. (Par exemple, voici les rapports de bug CPAN et Debian.) Si vous souhaitez un correctif, ces deux rapports de bogue ont des correctifs.

Si vous êtes dans un environnement restreint, vous pouvez essentiellement implémenter le correctif dans votre code. Par exemple, si vous souhaitez conserver tout dans un seul fichier, vous pouvez ajouter le grand bloc de code ci-dessous après use File::Find::Rule. Notez qu'il s'agit d'une solution très rapide et peut être sous-optimale. Si cela ne fonctionne pas pour vous (par exemple, parce que vous avez des espaces dans vos noms de fichiers), modifiez le modèle qr|^([-+@\w./]+)$| utilisé. Notez enfin que si vous voulez que votre organisation de code soit un peu meilleure, vous pouvez vouloir vider ceci dans un paquet séparé, peut-être appelé MyFileFindRuleFix ou quelque chose, que vous avez toujours use après use lui-même.

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;