perl - Deadlocks due to buffering. How does it work?

Question

The following question is a response to a comment about deadlocking in this answer. I am curious how deadlocks come about, so I created a test program: There is a parent process that writes a lot of data to the childs STDIN, whereas the child also writes a lot of data to the parent's reader handle. It turns out that there will be a deadlock if the data size exceeds 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 )
", 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..
", 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;

Why does this program deadlock?

Answer 1

The reason for the deadlock seems to be that the pipes get filled up when writing and no one reads from them. According to 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

Hence, the parent writes a long string to the child's STDIN pipe, the pipe gets filled up, which causes the parent to block. At the same time the child is writing a long string to parents reader pipe, this also gets filled up and the child blocks. So the child is waiting for the parent to read from its reader pipe, while the parent is waiting for the child to read from its STDIN pipe. A so-called deadlock.

I tried for fun to solve this by using select, fcntl, sysread and syswrite. Since syswrite will block if we try to write more than the capacity of the pipe, I used fcntl to make the writer handle non blocking. In that case, syswrite will write as much as possible to the pipe, and then return immediately with the number of bytes it actually wrote.

Note: only parent.pl needs to be changed (which is also desired, since we should not assume to have access to the child's source). Here is the modified parent.pl that will prevent the deadlock:

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 )
", 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..
", 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 : $!
";
    fcntl $fh, F_SETFL, $flags | O_NONBLOCK
      or die "Couldn't set flags for file handle: $!
";

}