perl - 由于缓冲导致死锁。它是如何工作的？

Question

以下问题是对 this 答案中有关死锁的评论的回应。很好奇死锁是怎么来的，所以我创建了一个测试程序:有一个父进程向子进程的STDIN写入大量数据，而子进程也向父进程的reader句柄写入大量数据。原来如果数据大小超过80K就会出现死锁(Ubuntu 16.04):

parent.pl :

use feature qw(say);
use strict;
use warnings;

use IPC::Open2;

my $test_size = 80_000; # How many bytes to write?
my $pid = open2( my $reader, my $writer, 'child.pl' );

my $long_string = '0123456789' x ($test_size / 10);
printf "Parent: writing long string ( length: %d )\n", length $long_string;
print $writer $long_string;
close $writer;
say "Parent: Trying to read childs ouput..";
my $output = do { local $/; <$reader> };
printf "Parent: Got output with length %d..\n", length $output;
close $reader;
say "Parent: Reaping child..";
waitpid( $pid, 0 );
my $child_exit_status = $? >> 8;
say "Parent: Child exited with status: $child_exit_status";

child.pl :

use feature qw(say);
use strict;
use warnings;

my $test_size = 80_000; # How many bytes to write?
my $child_log_filename = 'childlog.txt';

open ( my $log, '>', $child_log_filename ) or die "Could not create log file: $!";

say $log "Child is running..";

my $long_string = '0123456789' x ($test_size / 10);
say $log "Length of output string: " . length $long_string;
say $long_string;

my $input = do { local $/; <STDIN> };
say $log "Length of input string: " . length $input;
exit 2;

为什么这个程序会死锁？

Answer 1

死锁的原因似乎是管道在写入时被填满，没有人从中读取。根据 pipe(7) :

If a process attempts to write to a full pipe (see below), then write(2) blocks until sufficient data has been read from the pipe to allow the write to complete.

A pipe has a limited capacity. If the pipe is full, then a write(2) will block or fail, depending on whether the O_NONBLOCK flag is set. Different implementations have different limits for the pipe capacity. Applications should not rely on a particular capacity: an application should be designed so that a reading process consumes data as soon as it is available, so that a writing process does not remain blocked.

In Linux versions before 2.6.11, the capacity of a pipe was the same as the system page size (e.g., 4096 bytes on i386). Since Linux 2.6.11, the pipe capacity is 65536 bytes. Since Linux 2.6.35, the default pipe capacity is 65536 bytes

因此，父级向子级的 STDIN 管道写入一个长字符串，管道被填满，这导致父级阻塞。与此同时， child 正在向 parent 阅读器管道写入一个长字符串，这也被填满并且 child 阻塞。所以子进程等待父进程从它的读取器管道中读取，而父进程等待子进程从它的 STDIN 管道中读取。所谓的僵局。

我试图通过使用 select 、 fcntl 、 sysread 和 syswrite 来解决这个问题。由于如果我们尝试写入超过管道容量的内容， syswrite 会阻塞，因此我使用 fcntl 使编写器处理非阻塞。在这种情况下， syswrite 将尽可能多地写入管道，然后立即返回实际写入的字节数。

注意:只有 parent.pl 需要更改(这也是需要的，因为我们不应该假设可以访问 child 的源代码)。这是
修改后的 parent.pl 将防止死锁:

use feature qw(say);
use strict;
use warnings;

use Errno qw( EAGAIN );
use Fcntl;
use IO::Select;
use IPC::Open2;

use constant READ_BUF_SIZE => 8192;
use constant WRITE_BUF_SIZE => 8192;

my $test_size = 80_000; # How many bytes to write?
my $pid = open2( my $reader, my $writer, 'child.pl' );

make_filehandle_non_blocking( $writer );

my $long_string = '0123456789' x ($test_size / 10);
printf "Parent: writing long string ( length: %d )\n", length $long_string;
my $sel_writers = IO::Select->new( $writer );
my $sel_readers = IO::Select->new( $reader );
my $read_offset = 0;
my $write_offset = 0;
my $child_output = '';
while (1) {
    last if $sel_readers->count() == 0 && $sel_writers->count() == 0;
    my @sel_result = IO::Select::select( $sel_readers, $sel_writers, undef );
    my @read_ready = @{ $sel_result[0] };
    my @write_ready = @{ $sel_result[1] };
    if ( @write_ready ) {
        my $bytes_written = syswrite $writer, $long_string, WRITE_BUF_SIZE, $write_offset;
        if ( !defined $bytes_written ) {
            die "syswrite failed: $!" if $! != EAGAIN;
            $bytes_written = 0;
        }
        $write_offset += $bytes_written;
        if ( $write_offset >= length $long_string ) {
            $sel_writers->remove( $writer );
            close $writer;
        }
    }
    if ( @read_ready ) {
        my $bytes_read = sysread $reader, $child_output, READ_BUF_SIZE, $read_offset;
        if ( !defined $bytes_read ) {
            die "sysread failed: $!" if $! != EAGAIN;
            $bytes_read = 0;
        }
        elsif ( $bytes_read == 0 ) {
            $sel_readers->remove( $reader );
            close $reader;
        }
        $read_offset += $bytes_read;
    }
}
printf "Parent: Got output with length %d..\n", length $child_output;
say "Parent: Reaping child..";
waitpid( $pid, 0 );
my $child_exit_status = $? >> 8;
say "Parent: Child exited with status: $child_exit_status";

sub make_filehandle_non_blocking {
    my ( $fh ) = @_;

    my $flags = fcntl $fh, F_GETFL, 0
      or die "Couldn't get flags for file handle : $!\n";
    fcntl $fh, F_SETFL, $flags | O_NONBLOCK
      or die "Couldn't set flags for file handle: $!\n";

}