从 perl 确定父 shell

Question

从 perl 我想知道启动这个 perl 进程的 shell 的名称（可能还有路径）。

$ENV{SHELL} 不提供此功能（它提供您的登录 shell - 但当前的 perl 进程可能从不同的 shell 启动）。

到目前为止，我找到的最佳答案是：http://www.perlmonks.org/?node_id=556926，但它在不同平台上的表现非常糟糕（“ps”的输出因平台而异）。

我尝试查看 %ENV，但它只包含导出的变量。

那么有没有更好的办法呢？

背景

这将用于 GNU Parallel：每个作业都通过 shell 启动。为了给用户带来最小的惊喜，这个 shell 应该与启动 GNU Parallel 的 shell 相同。这样，tcsh 用户将能够使用 GNU Parallel 运行他的 tcsh 命令，对于 bash/zsh/*sh 用户也是如此。

当前使用 $SHELL，但它给出的是登录 shell，而不是当前 shell，这让用户感到惊讶，因为他们运行的 shell 与登录 shell 不同。如果 GNU Parallel 用于由 tcsh 用户编写但由 bash 用户运行的脚本，也会导致问题。

如果 GNU Parallel 不是从 shell 启动的，它将默认为 $SHELL（与现在相同）。

Answer 1

这样的事情怎么样：

#!/usr/bin/env perl

use strict;
use warnings;
use feature 'say';

use Proc::ProcessTable;

my $t = Proc::ProcessTable->new;

my $current_pid = $$;
my @parents;

# loop over the process table until we've found all the parents from perl pid
# up to init (process ID 1)
while ($current_pid != 1) {
    for my $process (@{ $t->table }) {
        if ($process->pid == $current_pid) {
            push @parents, $process;
            $current_pid = $process->ppid;
        }
    }
}

# loop over the parents we've found and look for something that looks like a
# shell command
for my $process (@parents) {
    my $cmd = $process->cmndline;

    if ($cmd =~ m/sh$/) {
        say $cmd;
        last;
    }
}

Answer 2

解决方案变成了这个，它不依赖于 C 编译器。

sub which {
    # Input:
    #   @programs = programs to find the path to
    # Returns:
    #   @full_path = full paths to @programs. Nothing if not found
    my @which;
    for my $prg (@_) {
    push @which, map { $_."/".$prg } grep { -x $_."/".$prg } split(":",$ENV{'PATH'});
    }
    return @which;
}

{
    my ($regexp,%fakename);

    sub parent_shell {
    # Input:
    #   $pid = pid to see if (grand)*parent is a shell
    # Returns:
    #   $shellpath = path to shell - undef if no shell found
    my $pid = shift;
    if(not $regexp) {
        # All shells known to mankind
        #
        # ash bash csh dash fdsh fish fizsh ksh ksh93 mksh pdksh
        # posh rbash rush rzsh sash sh static-sh tcsh yash zsh
        my @shells = qw(ash bash csh dash fdsh fish fizsh ksh
                            ksh93 mksh pdksh posh rbash rush rzsh
                            sash sh static-sh tcsh yash zsh -sh -csh);
        # Can be formatted as:
        #   [sh]  -sh  sh  busybox sh
        #   /bin/sh /sbin/sh /opt/csw/sh
        # NOT: foo.sh sshd crash flush pdflush scosh fsflush ssh
        my $shell = "(?:".join("|",@shells).")";
        $regexp = '^((\[)('. $shell. ')(\])|(|\S+/|busybox )('. $shell. '))($| )';
        %fakename = (
        # csh and tcsh disguise themselves as -sh/-csh
        "-sh" => ["csh", "tcsh"],
        "-csh" => ["tcsh", "csh"],
        );
    }
    my ($children_of_ref, $parent_of_ref, $name_of_ref) = pid_table();
    my $shellpath;
    my $testpid = $pid;
    while($testpid) {
        if($name_of_ref->{$testpid} =~ /$regexp/o) {
        $shellpath = (which($3.$6,@{$fakename{$3.$6}}))[0];
        $shellpath and last;
        }
        $testpid = $parent_of_ref->{$testpid};
    }
    return $shellpath;
    }
}

{
    my %pid_parentpid_cmd;

    sub pid_table {
    # return two tables:
    # pid -> children of pid
    # pid -> pid of parent
    # pid -> commandname

        if(not %pid_parentpid_cmd) {
        # Filter for SysV-style `ps`
        my $sysv = q( ps -ef | perl -ane '1..1 and /^(.*)CO?MM?A?N?D/ and $s=length $1;).
        q(s/^.{$s}//; print "@F[1,2] $_"' );
        # BSD-style `ps`
        my $bsd = q(ps -o pid,ppid,command -ax);
        # TODO test these on Cygwin, darwin
        %pid_parentpid_cmd =
        (
         'aix' => $sysv,
         'cygwin' => $sysv,
         'dec_osf' => $sysv,
         'darwin' => $bsd,
         'dragonfly' => $bsd,
         'freebsd' => $bsd,
         'gnu' => $sysv,
         'hpux' => $sysv,
         'linux' => $sysv,
         'mirbsd' => $bsd,
         'netbsd' => $bsd,
         'nto' => $sysv,
         'openbsd' => $bsd,
         'solaris' => $sysv,
         'svr5' => $sysv,
        );
    }
    $pid_parentpid_cmd{$^O} or die("pid_parentpid_cmd for $^O missing");

    my (@pidtable,%parent_of,%children_of,%name_of);
    # Table with pid -> children of pid
    @pidtable = `$pid_parentpid_cmd{$^O}`;
    my $p=$$;
    for (@pidtable) {
        # must match: 24436 21224 busybox ash
        /(\S+)\s+(\S+)\s+(\S+.*)/ or die("pidtable format: $_");
        $parent_of{$1} = $2;
        push @{$children_of{$2}}, $1;
        $name_of{$1} = $3;
    }
    return(\%children_of, \%parent_of, \%name_of);
    }
}