只要子进程仍在运行，就在父进程中每 90 秒在 perl 中记录一次消息

Question

由于我公司的要求，我刚刚从 php 转到 perl，所以即使这可能是一个愚蠢的问题，现在也有点紧张。

我通过 debian 软件包在服务器上部署了一个小的 perl 脚本。我把这一切都弄清楚了，所以这一切都很酷。

现在通过 SSH 连接从另一台服务器调用此脚本，并且脚本将其所有操作记录回该服务器。为此，我使用 Log::Log4perl。

其中一个任务需要很长时间，而且运行其他一些脚本也在处理中。 ssh 连接的超时设置为 5 分钟，除非我重新登录。所以我想出我会创建一个子进程来运行任务并让父进程每 90（或其他）秒记录一次。我的问题是 我不想使用睡眠 因为如果任务完成得越早它会弄乱日志。我也尝试过使用时间、Time::HiRes 和闹钟，但它们都以某种方式弄乱了我的日志。

这是我的代码：

    $log->info("uid $uid: calling the configure script for operation $mode,on $dst_path");

    my $pid   = fork();
    die "Could not fork\n" if not defined $pid;

    if ( $pid == 0 ) {
        configure( $script_dir, $mode, $node, $uid, $gid); # this also uses a parallel process in its execution, but we don't have a non blocking wait
    }
    while ( !waitpid( $pid, WNOHANG ) ) {
        sleep(90);
        if ( !$pid ) {
            $log->info("Still waiting for the process to finish"); # this should come up every 90 seconds of so
        }
    }

    $log->info("uid $uid: configure script executed"); # this should come up only once, now I get it every 90 seconds

    # do other stuff here after the execution of the configure sub is done

不幸的是我继承了这个架构，不能改变它，因为有很多服务基于它。

Answer 1

我尝试运行代码并注意到一些可能是您的问题，但由于不知道 configure 的作用，我无法确定。这是我的发现：

child 进程在调用 configure

exit

waitpid 不会改变 $pid 的值，所以 $pid 在 child 中总是 0 并且在 [=] 中总是 child 的 pid 45=].

这意味着 parent 永远不会写出 "Still waiting for the process to finish"，child 在完成配置调用后每 90 秒写出一次。

此外，child 应该永远每 90 秒打印一次该消息，因为它正在等待 pid 0 向它发送 CHLD 信号，这不会发生，因为它没有 child pid 0.

我用一些存根更新了您的代码，这些存根可以满足您的需求（时间稍微紧一点，因为我不想等待 :)）。我的代码做出了您可能希望更改的以下假设：

每秒记录一次等待消息
child 总是以状态值 0 退出

这是我的代码：

#!/usr/bin/env perl 

use strict;
use warnings;
use Log::Log4perl qw(:easy);
use POSIX qw(:sys_wait_h);

Log::Log4perl->easy_init();

my ($uid,$mode,$dst_path,$script_dir,$node,$gid) = (0..5);
my $log = get_logger();
$log->info("uid $uid: calling the configure script for operation $mode,on $dst_path");

my $pid   = fork();
die "Could not fork\n" if not defined $pid;

if ( $pid == 0 ) {
    configure( $script_dir, $mode, $node, $uid, $gid); # this also uses a parallel process in its execution, but we don't have a non blocking wait
    exit(0);
}
my $zombie;
while ( ($zombie = waitpid( $pid, WNOHANG ) ) != $pid) {
    $log->info("Still waiting for the process to finish"); # this should come up every 90 seconds of so
    sleep(1);
}

$log->info("uid $uid: configure script executed"); # this should come up only once, now I get it every 90 seconds

# do other stuff here after the execution of the configure sub is done

sub configure {
    sleep 10;
}

Answer 2

如果您不想睡觉，可以调用 select with a timeout. To implement this reliably, you can employ the self-pipe trick，这涉及创建一个管道，在 SIGCHLD 处理程序中写入管道，然后进行 select 调用等待管道的读取句柄。

这是一个简单的例子：

#!/usr/bin/perl
use strict;
use warnings;

use Errno qw(EINTR);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Symbol qw(gensym);

sub make_non_blocking {
    my $handle = shift;
    my $flags = fcntl($handle, F_GETFL, 0)
        or die("F_GETFL: $!");
    fcntl($handle, F_SETFL, $flags | O_NONBLOCK)
        or die("F_SETFL: $!");
}

my ($read_handle, $write_handle) = (gensym, gensym);
pipe($read_handle, $write_handle)
    or die("pipe: $!");

make_non_blocking($read_handle);
make_non_blocking($write_handle);

local $SIG{CHLD} = sub {
    syswrite($write_handle, "[=10=]", 1);
};

my $pid = fork();
die("fork: $!") if !defined($pid);

if ($pid == 0) {
    sleep(10);
    exit;
}

my $rin = '';
vec($rin, fileno($read_handle), 1) = 1;

while (1) {
    my $nfound = select(my $rout = $rin, undef, undef, 2);
    if ($nfound < 0) {
        # Error. Must restart the select call on EINTR.
        die("select: $!") if $! != EINTR;
    }
    elsif ($nfound == 0) {
        # Timeout.
        print("still running...\n");
    }
    else {
        # Child exited and pipe was written to.
        last;
    }
}

waitpid($pid, 0);

close($read_handle);
close($write_handle);

只要子进程仍在运行，就在父进程中每 90 秒在 perl 中记录一次消息

Log message in perl every 90 seconds in the parent process as long as the child process still runs

linux

ssh

perl