Handle combination of signals and child exit values for simple parent-child IPC?

Question

I am trying to figure out the correct way to handle a simple case of parent-child interprocess communication (IPC). The child sends messages to the parent through the child's STDOUT handle. The parent does not send any messages to the child (except for SIGPIPE if it dies). In addition both child and parent need to handle a SIGINT signal from the user at the terminal. The main difficulty for the parent process is to correctly pick up the child's exit status when the child dies from SIGINT or SIGPIPE.

parent.pl:

#! /usr/bin/env perl

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

my $child_pid = open ( my $fh, '-|', 'child.pl' ) or die "Could not start child: $!";

$SIG{INT} = sub {
    $SIG{CHLD}="IGNORE";
    die "Caught SIGINT"
};

my $child_error;

$SIG{CHLD} = sub {
    $SIG{INT}="IGNORE";
    waitpid $child_pid, 0;
    $child_error = $?;
    die "Caught SIGCHLD: Child exited.."
};

eval {
    while (1) {
        msg( "sleeping(1).." );
        sleep 1;
        #internal_failure();
        msg( "waiting for child input.." );
        my $line = <$fh>;
        if ( defined $line ) {
            chomp $line;
            msg( "got line: '$line'" );
        }
        else {
            die "Could not read child pipe.";
        }
        msg( "sleeping(2).." );
        sleep 2;
    }
};

if ( $@ ) {
    chomp $@;
    msg( "interrupted: '$@'" );
}

my $close_ok = close $fh; # close() will implicitly call waitpid()
if ( !$close_ok ) {
    msg( "Closing child pipe failed: $!" );
    if ( !defined $child_error ) {
        waitpid $child_pid, 0;
    }
}
if ( !defined $child_error ) {
    $child_error = $?;
}
my $child_signal = $child_error & 0x7F;
if ( $child_signal ) {
    msg( "Child died from signal: $child_signal" );
}
else {
    msg( "Child exited with return value: " . ($child_error >> 8) );
}
exit;

sub msg { say "Parent: " . $_[0]  }

sub internal_failure {
    $SIG{CHLD}="IGNORE";
    $SIG{INT}="IGNORE";
    die "internal failure";
}

child.pl:

#! /usr/bin/env perl

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

$SIG{PIPE} = sub {
    $SIG{INT}="IGNORE";
    die "Caught SIGPIPE: Parent died.";
};

$SIG{INT} = sub {
    $SIG{PIPE}="IGNORE";
    die "Caught SIGINT\n";  # For some reason a newline is needed here !?
};

#local $SIG{INT} = "IGNORE";

STDOUT->autoflush(1); # make parent see my messages immediately
msg( "running.." );
eval {
    sleep 2;
    say "Hello"; # should trigger SIGPIPE signal if parent is dead
    sleep 1;
};
if ( $@ ) {
    chomp $@;
    msg( "interrupted: '$@'" );
    exit 2;
}

msg( "exits" );
exit 1;

Normal output from running parent.pl from command line would be:

Parent: sleeping(1)..
Child: running..
Parent: waiting for child input..
Parent: got line: 'Hello'
Parent: sleeping(2)..
Child: exits
Parent: interrupted: 'Caught SIGCHLD: Child exited.. at ./parent.pl line 20, <$fh> line 1.'
Parent: Closing child pipe failed: No child processes
Parent: Child exited with return value: 1

Question 1: Signal handlers

Is it correct to disable the other signals in a given signal handler? For example in the parent's SIGINT handler I have

$SIG{CHLD}="IGNORE";

to avoid also receiving the SIGCHLD at later point. For example, if I did not disable the child signal, it could arrive in the cleanup part (after the eval block) in the parent, and make the parent die before it has finished its cleanup.

Question 2: Handling SIGINT

If I press CTRL-C after starting the parent, the output typically looks like:

Parent: sleeping(1)..
Child: running..
Parent: waiting for child input..
^CChild: interrupted: 'Caught SIGINT'
Parent: interrupted: 'Caught SIGINT at ./parent.pl line 11.'
Parent: Closing child pipe failed: No child processes
Parent: Child died from signal: 127

The problem here is the exit status of the child. It should be 2, but instead it is killed by signal 127. What is the meaning of signal 127 here?

Question 3: Parent dies from internal failure

If I uncomment the line

#internal_failure();

in parent.pl, the output is:

Parent: sleeping(1)..
Child: running..
Parent: interrupted: 'internal failure at ./parent.pl line 71.'
Child: interrupted: 'Caught SIGPIPE: Parent died. at ./child.pl line 9.'
Parent: Closing child pipe failed: No child processes
Parent: Child died from signal: 127

This seems to work well except for the exit status from the child process. It should be 2, instead it is killed by signal 127.

Answer 1

You set the children to be automatically reaped ($SIG{CHLD} = "IGNORE";), then you called waitpid not once but twice more!

The subsequent calls to waitpid set $? to -1 (signaling an error, but that you misinterpret as "killed by signal"), and $! to No child processes.

Fixes:

$ diff -u ./parent.pl{~,}
--- ./parent.pl~        2016-09-19 19:28:39.778244653 -0700
+++ ./parent.pl 2016-09-19 19:28:10.698227008 -0700
@@ -7,16 +7,12 @@
 my $child_pid = open ( my $fh, '-|', 'child.pl' ) or die "Could not start child: $!";

 $SIG{INT} = sub {
-    $SIG{CHLD}="IGNORE";
+    $SIG{CHLD}="DEFAULT";
     die "Caught SIGINT"
 };

-my $child_error;
-
 $SIG{CHLD} = sub {
     $SIG{INT}="IGNORE";
-    waitpid $child_pid, 0;
-    $child_error = $?;
     die "Caught SIGCHLD: Child exited.."
 };

@@ -44,29 +40,19 @@
     msg( "interrupted: '$@'" );
 }

-my $close_ok = close $fh; # close() will implicitly call waitpid()
-if ( !$close_ok ) {
-    msg( "Closing child pipe failed: $!" );
-    if ( !defined $child_error ) {
-        waitpid $child_pid, 0;
-    }
-}
-if ( !defined $child_error ) {
-    $child_error = $?;
-}
-my $child_signal = $child_error & 0x7F;
-if ( $child_signal ) {
-    msg( "Child died from signal: $child_signal" );
-}
-else {
-    msg( "Child exited with return value: " . ($child_error >> 8) );
-}
+close $fh; # close() will implicitly call waitpid()
+
+if    ( $? == -1  ) { msg( "Closing child pipe failed: $!" ); }
+elsif ( $? & 0x7F ) { msg( "Child died from signal ".( $? & 0x7F ) ); }
+elsif ( $? >> 8   ) { msg( "Child exited with error ".( $? >> 8 ) ); }
+else                { msg( "Child executed successfully" ); }
+
 exit;

 sub msg { say "Parent: " . $_[0]  }

 sub internal_failure {
-    $SIG{CHLD}="IGNORE";
+    $SIG{CHLD}="DEFAULT";
     $SIG{INT}="IGNORE";
     die "internal failure";
 }

Fixed parent.pl:

#! /usr/bin/env perl

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

my $child_pid = open ( my $fh, '-|', 'child.pl' ) or die "Could not start child: $!";

$SIG{INT} = sub {
    $SIG{CHLD}="DEFAULT";
    die "Caught SIGINT"
};

$SIG{CHLD} = sub {
    $SIG{INT}="IGNORE";
    die "Caught SIGCHLD: Child exited.."
};

eval {
    while (1) {
        msg( "sleeping(1).." );
        sleep 1;
        #internal_failure();
        msg( "waiting for child input.." );
        my $line = <$fh>;
        if ( defined $line ) {
            chomp $line;
            msg( "got line: '$line'" );
        }
        else {
            die "Could not read child pipe.";
        }
        msg( "sleeping(2).." );
        sleep 2;
    }
};

if ( $@ ) {
    chomp $@;
    msg( "interrupted: '$@'" );
}

close $fh; # close() will implicitly call waitpid()

if    ( $? == -1  ) { msg( "Closing child pipe failed: $!" ); }
elsif ( $? & 0x7F ) { msg( "Child died from signal ".( $? & 0x7F ) ); }
elsif ( $? >> 8   ) { msg( "Child exited with error ".( $? >> 8 ) ); }
else                { msg( "Child executed successfully" ); }

exit;

sub msg { say "Parent: " . $_[0]  }

sub internal_failure {
    $SIG{CHLD}="DEFAULT";
    $SIG{INT}="IGNORE";
    die "internal failure";
}

The signal handling is still quite messy, but I wanted to avoid changing code unrelated to the fix.