Question

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

$ ENV {SHELL}没有给出这个（它给你的登录shell - 但是当前的perl进程可能是从另一个shell启动的。）

到目前为止，我找到的最佳答案是：http://www.perlmonks.org/?node_id=556926但是它与不同的平台非常相似（＆＃39; ps＆＃39;的输出在平台之间存在很大差异。）

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

那么有更好的方法吗？

背景

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

目前使用了$ SHELL，但是它提供了登录shell而不是当前的shell，这对于运行与登录shell不同的shell的用户来说是令人惊讶的。如果在tcsh-user编写的脚本中使用GNU Parallel，但由bash-user运行，也会导致问题。

如果没有从shell启动GNU Parallel，它将默认为$ 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);
    }
}

从perl确定父shell

2 个答案: