Question

我有一个我正在管理的Perl程序，它能够分叉多个进程（达到指定的限制），监视它们，并在它们退出时，分叉其他进程（再一次，直到限制），直到完成运行的事物列表。它工作正常，除了某些原因它似乎没有从我的子进程中获取正确的退出状态。

无效的代码使用Perl的fork()，waitpid()，子进程使用POSIX::_exit()退出。以下是相关代码的一些摘录：

分叉代码：

# Initialize process if running in parallel mode
my $pid;
if ($options{'parallel'} > 0) {
    log_status("Waiting to fork test #".$curr_test{'id'}."...\n");

    # Here, wait for child processes to complete so we can fork off new ones without going over the specified limit
    while ( keys(%children) >= $options{'parallel'}) {
        my $kid = waitpid(-1, 0);
        my $kid_status = $?;

        if ($kid > 0) {
            log_status("Child process (PID ".$kid.", test ".$children{$kid}.") exited with status ".$kid_status.".\n");
            $error_status |= $kid_status;
            delete $children{$kid};
        }
    }

    $pid = fork();
    tdie("Unable to fork!\n") unless defined $pid;

    if ($pid != 0) {
        # I'm the parent
        $is_child = 0;
        log_status("Forked child process (PID ".$pid.").\n");

        $children{$pid} = $curr_test{'logstr'};

        next TEST_LOOP;
    }
    else {
        # I'm the child
        $is_child = 1;
        log_status("Starting test = ".$curr_test{'logstr'}."\n");
    }
}

退出子流程代码：

### finish_child() ###
# Handles exiting the script, like the finish() function, but only when running as a child process in parallel mode.
# Parameters:
#   - The error code to exit with
###
sub finish_child( $ ) {
    my ($error_status) = @_;


    # If running in parallel mode, exit this fork
    if ($options{'parallel'} > 0) {
        log_status("Entering: ".Cwd::abs_path("..")."\n");
        chdir "..";
        log_status("Exiting with status: ".$error_status."\n");
        POSIX::_exit($error_status);
    }
}

以下是我的示例游戏中调用finish_child()的地方：

# If build failed, log status and gracefully clean up logfiles, then continue to next test in list.
if ($test_status > 0) {
    $email_subject = "Build failed!";
    log_status("Build of ".$testline." FAILED.\n");
    tlog(1, "Build of ".$testline." FAILED.\n");

    log_status("Entering: ".Cwd::abs_path("..")."\n");
    chdir "..";


    log_report(\%curr_test, $test_status);

    # Print out pass/fail status for each test as it completes
    $quietmode = $options{'quiet'}; # Backup quiet mode setting
    $options{'quiet'} = 0;

    if ($test_status == 0) {
        log_status("Test ".$testline." PASSED.\n");
        tlog(0, "Test ".$testline." PASSED.\n");
    }
    else {
        log_status("Test ".$testline." FAILED.\n");
        tlog(1, "Test ".$testline." FAILED.\n");
    }

    $options{'quiet'} = $quietmode;  # Restore quiet mode setting
    finish_logs();


    # Link logs to global area and rename if running multiple tests
    system("ln -sf ".$root_dir."/verify/".$curr_test{'id'}."/".$verify::logfile." ../".(($test_status > 0) ? "fail".$curr_test{'id'}.".log" : "pass".$curr_test{'id'}.".log" )) if (@tests > 1);


    if ($options{'parallel'} > 0 && $pid == 0) {
        # If we're in parallel mode and I'm a child process, I should exit, instead of continuing to loop.
        finish_child($test_status);
    }
    else {
        # If we're not in parallel mode, I should continue to loop.
        next TEST_LOOP;
    }
}

以下是我根据运行日志看到的行为：

<Parent> Waiting for all child processes to complete...
<Child> [PID 28657] Entering: <trimmed>
<Child> [PID 28657] Running user command: make --directory <trimmed> TARGET=build BUILD_DIR=<trimmed> RUN_DIR=<trimmed>            
<Child> [PID 28657] User command finished with return code: 512
<Child> [PID 28657] Build step finished with return code 512
<Child> [PID 28657] Entering: <trimmed>
<Child> [PID 28657] Build of rx::basic(1) FAILED.
<Child> [PID 28657] Entering: <trimmed>
<Child> [PID 28657] Test rx::basic(1) FAILED.
<Child> [PID 28657] Closing log file.
<Child> [PID 28657] Closing error log file.
<Child> [PID 28657] Entering: <trimmed>
<Parent> Child process (PID 28657, test rx::basic(1)) exited with status 0.

我有使用Perl IPC运行命令的代码（代替system()调用，以获得更好的灵活性，可以正确地获取退出代码，您可以在日志的“用户命令”行中看到文件。

我在这里做错了什么？在这种情况下，为什么我无法从$?获取退出状态？我在网上找到的例子似乎都表明这应该可行。

作为参考，我正在运行Perl v5.10.1。如果您认为需要查看其余代码，则此Perl工具也是在GitHub上开源的：https://github.com/benrichards86/Verify/blob/master/verify.pl

Answer 1

如果$test_status为512，您是否正在呼叫POSIX::_exit(512)？那是不对的。子进程应该使用0到255范围内的操作数调用POSIX::_exit，并且将该子进程的Perl父进程设置为{em> exit-status {{ 1}}。

$?相当于<< 8或POSIX::_exit(512)。

Answer 2

看来你正在做的事情如下：

exit($?)

您的意思是将孩子传递给exit的值传播，但这不是$?包含的值。

如果孩子被信号杀死，$? & 0x7F包含杀死该过程的信号编号。

如果孩子没有被信号杀死，$? & 0x7F为零，$? >> 8包含流程传递给exit的值。

因此当孩子exit(1)时，你做exit(256)，那在Unix系统上超出了范围。高位被切断，留下零（256 & 0xFF = 0）。

我建议您执行bash所做的事情：

exit( ($? & 0x7F) ? ($? | 0x80) : ($? >> 8) );

当孩子exit(1)时，这会exit(1)。

当孩子被SIGTERM（15）杀死时，这会exit(128 + 15)。

Answer 3

是的，这可能是解释，但令我感兴趣的是你的测试输出没有显示孩子实际使用的退出状态。代码中有一条日志消息（“退出状态：......”）但输出中没有对应的行。

因此，我们无法确定代码的这一部分是否存在任何问题。

我首先想到使用POSIX :: _ exit可以解释日志记录问题（它会阻止刷新最终缓冲区），但是再次查看你的代码我看到你在调用finish_child之前已经关闭了。

我建议您首先让日志记录正常工作，以便了解问题所在。为什么不在退出之前将日志关闭和日志文件重命名逻辑移动到完成子例程中作为最后一件事？

至于退出状态问题，我看到三种可能的解释，都在子进程的代码中：

孩子实际上并没有通过功能finish_child
您认为传递给finish_child然后实际退出的非零状态未被传递
如上所述，您的退出状态为＆gt; 255

您使用POSIX :: _ exit（）而不是exit（）和waitpid（-1）而不是wait（）的原因是什么？

为什么我不从我的子进程中获取退出状态？

3 个答案: