管道被 Perl 中的子进程阻塞
Posted
技术标签:
【中文标题】管道被 Perl 中的子进程阻塞【英文标题】：Pipe is blocked by sub-process in Perl 【发布时间】：2013-01-21 07:02:08 【问题描述】：我写了两个perl脚本（parent.pl和child.pl），源码如下：
parent.pl：
# file parent.pl
$SIGCHLD = sub
while(waitpid(-1, WNOHANG) > 0)
print "child process exit\n";
;
my $pid = fork();
if($pid == 0)
system("perl child.pl");
exit;
while(1)
open my $fh, "date |";
while(<$fh>)
print "parent: ".$_;
close $fh;
sleep(2);
child.pl
#file child.pl
while(1)
open my $fh, "date |";
while(<$fh>)
print " child: ".$_;
close $fh;
sleep(2);
我想要的是父进程和分叉的子进程交替输出当前日期。但是当我运行perl parent.pl时，输出是这样的：
$ perl parent.pl
parent: Mon Jan 21 14:53:36 CST 2013
child: Mon Jan 21 14:53:36 CST 2013
child: Mon Jan 21 14:53:38 CST 2013
child: Mon Jan 21 14:53:40 CST 2013
child: Mon Jan 21 14:53:42 CST 2013
child: Mon Jan 21 14:53:44 CST 2013
好像打开管道时父进程被阻塞了。
但如果我删除信号 CHLD 的以下操作。
$SIGCHLD = sub
while(waitpid(-1, WNOHANG) > 0)
print "child process exit\n";
;
然后再次运行它。好像没问题。
$ perl parent.pl
parent: Mon Jan 21 14:57:57 CST 2013
child: Mon Jan 21 14:57:57 CST 2013
parent: Mon Jan 21 14:57:59 CST 2013
child: Mon Jan 21 14:57:59 CST 2013
parent: Mon Jan 21 14:58:01 CST 2013
child: Mon Jan 21 14:58:01 CST 2013
但我还是觉得不解。为什么我尝试打开管道时父进程被阻止？
我不认为删除 SIGCHLD 函数是个好主意，因为应该检索僵尸进程。
有人可以帮助我吗？非常感谢！
================================================ ====================
感谢@Borodin 帮助我解决了我的难题。我曾尝试像这样修改parent.pl：
my $main_pid = $$;
$SIGUSR1 = sub
#sleep(1);
while(waitpid(-1, WNOHANG) > 0)
print "child process exit\n";
;
my $pid = fork();
if($pid == 0)
$SIGUSR1 = 'IGNORE';
system("perl child.pl");
kill USR1, $main_pid;
exit;
while(1)
open my $fh, "date |";
while(<$fh>)
print "parent: ".$_;
close $fh;
sleep(2);
由于CHLD 信号可能会被open 或system 启动，所以我使用了另一个自定义信号USR1。现在效果很好。
================================================ ==========================
上面的修改还是有问题的。分叉的子进程在退出前发送 USR1 信号。可能是父进程应该在waitpid之前休眠一段时间，因为子进程还没有退出。
我现在不手动检索子流程，并设置$SIG$CHLD = 'IGNORE'。希望子进程退出时能被操作系统找回。
【问题讨论】：
【参考方案1】：这变得更加复杂，因为open my $fh, "date |" 和system("perl child.pl") 都在启动子进程，以及显式的fork。
所以fork 启动了一个子进程，它执行system("perl child.pl") 来启动它自己的子进程，然后它又执行open my $fh, "date |"，这又打开了另一个子进程，它现在是主父进程的曾孙.
同时，主进程执行自己的open my $fh, "date |"，它启动另一个子进程。最后，主进程有两个孩子，一个孙子和一个曾孙。
不幸的是，使用open 或system 开始的孩子有一个隐含的wait 附加到他们，所以当他们完成时他们会启动CHLD 信号但是当处理程序被执行时没有剩下任何东西等待它会像你看到的那样挂起。
perldoc perlipc有话要说
小心：qx()、system() 和一些用于调用外部命令的模块执行 fork()，然后 wait() 得到结果。因此，您的信号处理程序将被调用。因为 system() 或 qx() 已经调用了 wait()，所以信号处理程序中的 wait() 将不再看到僵尸，因此会阻塞。
您可以通过只保留一个父进程和一个子进程来让事情顺利进行，就像这样。
use strict;
use warnings;
use POSIX ':sys_wait_h';
STDOUT->autoflush;
$SIGCHLD = sub
while(waitpid(-1, WNOHANG) > 0)
print "child process exit\n";
;
my $pid = fork();
if ($pid == 0)
while(1)
printf " child: %s\n", scalar localtime;
sleep(2);
else
while(1)
printf "parent: %s\n", scalar localtime;
sleep(2);
【讨论】：
感谢您的回复一百万。以上面两个脚本为例。我在分叉子流程中实际执行的操作会复杂得多，child.pl 可能因情况而异。所以我不能在一个父进程和一个子进程中做到这一点。既然wait()已经被open和system调用了，那我可以直接去掉SUBCHLD函数，在分叉的子进程存在之前再发送一个信号吗？
在您的帮助下，我对parent.pl 进行了上述修改。现在看来还可以。谢谢！【参考方案2】：
选项 1
实现所需的一种方法是与一对半双工管道同步，该管道由pipe 和open 创建。使用全双工socketpair 可以简化簿记。
在"|-" 上打开一个句柄隐式forks 一个子进程，其标准输入是管道的读取端，写入端是返回给父级的文件句柄。父级使用此隐式管道释放子级，并将显式创建的管道用作反向通道。
#! /usr/bin/env perl
use strict;
use warnings;
use Fcntl qw/ F_GETFD F_SETFD FD_CLOEXEC /;
use IO::Handle;
pipe my $fromchild, my $toparent or die "$0: pipe: $!";
$_->autoflush(1) for $toparent, $fromchild;
my $flags = fcntl $toparent, F_GETFD, 0 or die "$0: fcntl: $!";
fcntl $toparent, F_SETFD, $flags & ~FD_CLOEXEC or die "$0: fcntl: $!";
my $pid = open my $tochild, "|-";
$tochild->autoflush(1);
die "$0: fork: $!" unless defined $pid;
if ($pid != 0)
while (1)
print "parent: ", scalar localtime, "\n";
sleep 1;
print $tochild "over\n";
chomp($_ = <$fromchild>);
exit 0 if $_ eq "over and out";
else
exec "child.pl", fileno $toparent
or die "$0: exec: $!";
child.pl 中的代码如下。请注意，父级传递了一个文件descriptor，子级必须dup 才能在另一个方向上与父级通信。
#! /usr/bin/env perl
use strict;
use warnings;
use IO::Handle;
my($fd) = @ARGV or die "Usage: $0 to-parent-fd\n";
open my $toparent, ">&=", $fd or die "$0: dup: $!";
$toparent->autoflush(1);
my $rounds = 5;
for (1 .. $rounds)
my $over = <STDIN>;
print " child: ", scalar localtime, "\n";
sleep 1;
print $toparent ($_ < $rounds ? "over\n" : "over and out\n");
exit 0;
在音乐会上，他们看起来像
父母：2013 年 1 月 21 日星期一 18:10:39 儿童：2013 年 1 月 21 日星期一 18:10:40 家长：2013 年 1 月 21 日星期一 18:10:41 孩子：2013 年 1 月 21 日星期一 18:10:42 家长：2013 年 1 月 21 日星期一 18:10:43 儿童：2013 年 1 月 21 日星期一 18:10:44 家长：2013 年 1 月 21 日星期一 18:10:45 孩子：2013 年 1 月 21 日星期一 18:10:46 家长：2013 年 1 月 21 日星期一 18:10:47 孩子：2013 年 1 月 21 日星期一 18:10:48
选项 2
一种更奇特的安排是让子流程安排在一个环或循环中彼此轮流。在父进程和子进程之间来回走动只是一个长度为 2 的循环。
#! /usr/bin/env perl
use strict;
use warnings;
use IPC::SysV qw/ IPC_CREAT IPC_PRIVATE S_IRUSR S_IWUSR /;
use IPC::Semaphore;
my $WORKERS = 3;
给定的工人从集合中获取自己的信号量，但在完成后释放下一个工人。
sub take
my($id,$sem) = @_;
$sem->op($id, -1, 0) or die "$0: semop: $!";
sub release
my($id,$sem) = @_;
my $next = ($id + 1) % $WORKERS;
$sem->op($next, 1, 0) or die "$0: semop: $!";
sub worker
my($id,$sem) = @_;
for (1 .. 3)
take $id, $sem;
print "[worker $id]: ", scalar localtime, "\n";
sleep 1;
release $id, $sem;
创建信号量集并让第一个准备好运行。
my $sem = IPC::Semaphore->new(
IPC_PRIVATE,
$WORKERS,
IPC_CREAT | S_IRUSR | S_IWUSR)
or die "$0: semget: $!";
$sem->setall((0) x $WORKERS);
$sem->setval(0, 1); # unblock first only
现在我们准备fork 子进程并让它们执行。
foreach my $id (0 .. $WORKERS - 1)
my $pid = fork;
die "$0: fork: $!" unless defined $pid;
if ($pid == 0)
worker $id, $sem;
exit 0;
# wait on all workers to finish
my $pid;
do
$pid = waitpid -1, 0;
while $pid > 0;
样本输出：
[worker 0]：2013 年 1 月 21 日星期一 18:13:27 [工人 1]：2013 年 1 月 21 日星期一 18:13:28 [工人 2]：2013 年 1 月 21 日星期一 18:13:29 [工人 0]：2013 年 1 月 21 日星期一 18:13:30 [工人 1]：2013 年 1 月 21 日星期一 18:13:31 [工人 2]：2013 年 1 月 21 日星期一 18:13:32 [工人 0]：2013 年 1 月 21 日星期一 18:13:33 [工人 1]：2013 年 1 月 21 日星期一 18:13:34 [工人 2]：2013 年 1 月 21 日星期一 18:13:35
【讨论】：
以上是关于管道被 Perl 中的子进程阻塞的主要内容，如果未能解决你的问题，请参考以下文章