view release on metacpan or  search on metacpan

t/0007-extcmd-env.t  view on Meta::CPAN

    ##################################################################

    # EE04: no inline perl -e/-ne/-pe may be wrapped in single quotes,
    # which cmd.exe does not honor (Windows portability).
    sub {
        my @hits = _scan_perl_oneliners('SQ');
        if (@hits) { for my $h (@hits) { print "# WIN-HAZARD (single-quote): $h\n" } }
        _ok(!@hits,
            'EE04: no single-quote inline Perl in t/ eg/ lib/ doc/ README'
            . (@hits ? ' (' . scalar(@hits) . ' hit(s))' : ''));
    },

    ##################################################################
    # 5. Static guard (A): /bin/sh dollar-expansion hazard
    ##################################################################

    # EE05: no double-quoted inline perl -e/-ne/-pe may contain a
    # shell-expandable dollar token ($_ , $name , ${...} , $1..$9),
    # which /bin/sh would expand using the environment (Unix portability).
    # The harmless numeric $$ (PID) is exempt.
    sub {
        my @hits = _scan_perl_oneliners('DOLLAR');
        if (@hits) { for my $h (@hits) { print "# UNIX-HAZARD (dollar): $h\n" } }
        _ok(!@hits,
            'EE05: no shell-dollar in double-quoted inline Perl (all docs)'
            . (@hits ? ' (' . scalar(@hits) . ' hit(s))' : ''));
    },

);

######################################################################
# Helpers
######################################################################

# Scan every t/*.t and eg/* file for inline Perl one-liners and return
# the offending lines for the requested hazard class:
#   'SQ'     -- the -e/-ne/-pe flag is immediately followed by a single
#               quote (cmd.exe-unsafe wrapping).
#   'DOLLAR' -- the code is double-quoted and contains a dollar token
#               that /bin/sh would expand ($ + letter/underscore/digit
#               or ${ ), excluding the harmless numeric $$.
# Backslash-escaped quotes (\" \') as they appear inside .t string
# literals are normalised first, so the scan sees the effective command.
sub _scan_perl_oneliners {
    my ($mode) = @_;
    my $root = File::Spec->catdir($FindBin::Bin, File::Spec->updir);
    my @hits;
    # Directories scanned (relative to the distribution root), plus the
    # top-level README.  Covers executable code (t/, eg/), the module
    # POD samples (lib/), and the 21-language reference docs (doc/), so a
    # non-portable inline-Perl one-liner cannot be reintroduced anywhere.
    my @relfiles;
    for my $sub ('t', 'eg', 'doc', 'lib', 'lib/BATsh') {
        my $dir = File::Spec->catdir($root, split(m{/}, $sub));
        next unless -d $dir;
        local *EE_DIR;
        next unless opendir(EE_DIR, $dir);
        my @names = sort grep { $_ !~ /\A\./ } readdir(EE_DIR);
        closedir(EE_DIR);
        for my $name (@names) {
            # Only canonical source files; skip backups / editor files
            # (e.g. *-OLD, *-OLD2, *.bak, *~) that may sit in the tree.
            my $ok = 0;
            if    ($sub eq 't')   { $ok = ($name =~ /\.t\z/) }
            elsif ($sub eq 'eg')  { $ok = ($name =~ /\.(?:batsh|pl)\z/) }
            elsif ($sub eq 'doc') { $ok = ($name =~ /\.txt\z/) }
            else                  { $ok = ($name =~ /\.pm\z/) }   # lib, lib/BATsh
            next unless $ok;
            push @relfiles, "$sub/$name";
        }
    }
    push @relfiles, 'README';

    for my $rel (@relfiles) {
        # This regression file documents the hazards in prose on purpose,
        # so it must not scan itself.
        next if $rel =~ /0007-extcmd-env\.t\z/;
        my $path = File::Spec->catfile($root, split(m{/}, $rel));
        next unless -f $path;
        local *EE_FH;
        next unless open(EE_FH, $path);
        my $lineno = 0;
        while (<EE_FH>) {
            $lineno++;
            my $line = $_;
            $line =~ s/[\r\n]+\z//;
            # Skip full-line comments (Perl/SH '#', CMD '::' / 'REM') so
            # prose that merely mentions perl one-liners is ignored.
            next if $line =~ /\A\s*#/;
            next if $line =~ /\A\s*::/;
            next if $line =~ /\A\s*(?:REM|rem)\b/;
            # Normalise escaped quotes from .t string literals.
            my $eff = $line;
            $eff =~ s/\\"/"/g;
            $eff =~ s/\\'/'/g;
            my $bad = 0;
            if ($mode eq 'SQ') {
                # perl <flags ending in e> followed by a single quote
                $bad = 1 if $eff =~ /\bperl\b[^|<>;&`]*?-\w*e\b\s*'/;
            }
            else {
                # perl <flags ending in e> "double-quoted-code"
                if ($eff =~ /\bperl\b[^|<>;&`]*?-\w*e\b\s*"([^"]*)"/) {
                    my $code = $1;
                    $bad = 1 if $code =~ /\$[A-Za-z_0-9{]/;
                }
            }
            push @hits, "$rel:$lineno: $line" if $bad;
        }
        close(EE_FH);
    }
    return @hits;
}

sub _capture {
    my ($code) = @_;
    my $tmpfile = File::Spec->catfile(
        File::Spec->tmpdir(), "batsh_cap7_$$\.tmp");
    open(_CAP_OLD, '>&STDOUT') or return '';
    open(_CAP_FH,  ">$tmpfile") or do { open(STDOUT, '>&_CAP_OLD'); return '' };
    open(STDOUT, '>&_CAP_FH');