Influencing control flow using a signal handler

Bloehdian has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks,

in the sample code below three processes are generated using fork(), the parent process and two child processes. The child processes are generated using the subs run_one and run_two.

The parent process is continuously exchanging text messages with the childs, moreover, all three processes share a variable $shared by tie()ing it to MCE::Shared. I only mention this for completeness, the sharing issue is not relrevant for the problem a hand.

What I intend to do is to send signals (to be specific, SIGUSR1 and SIGUSR2 for the child process denoted with "one" and the child process denoted with "two"., resp.) from the command line to the program (the signal handler is defined in the parent process!) and trigger kill()ing ONE of the processes (simulating a crashing of the respective child).

After kill()ing one child, the parent process should kill the remaining child using a the subroutine check_kill() and create to new child processes. This should be done by leaving the inner while(1), in which the parent does it's work, and start a new iteration of the outer while (using the label START).

My idea was to set the variable $restart to a true value when the signal arrives, so that the inner loop is left on "next START".

I created a subroutine kill_and_restart(), which is basically the signal handler, but to no avail. Since I obviously cannot change the variable $restart from within this subroutine, I cannot trigger leave of the inner while loop by use of the signal handler, not even when $restart is passed as a reference to the sub (or am I doing something wrong here?).

Restart of the two childs HAVE to be done by reiterating the outer loop, the control flow is fixed.

But: How can I reach this using the signal handler?

Cheers

Blohdian

#!/usr/bin/perl

use strict;
use warnings;

use IO::Handle;
use MCE::Shared;
use Fcntl;
use Scalar::Util qw( openhandle );
use POSIX qw( WNOHANG );

my $shared;

my $from_parent_one;
my $to_child_one;
my $from_child_one;
my $to_parent_one;

my $from_parent_two;
my $to_child_two;
my $from_child_two;
my $to_parent_two;

my @pipe_handles = ( $from_parent_one,
                     $to_child_one,
                     $from_child_one,
                     $to_parent_one,
                     $from_parent_two,
                     $to_child_two,
                     $from_child_two,
                     $to_parent_two );
                     
my $pid_one;
my $pid_two;

my $line;

my $debug = $ENV{ 'DEBUG' } ? 1 : 0;

my $restart = 0;
my $restart_ref = \$restart;

START: while ( 1 ) {
   
   print( "(Re-)Starting ...\n" );

   # To be sure possibly remaining open pipe handles
   # are close before creating new ones
   #
   foreach my $handle ( @pipe_handles ) {

      close( $handle ) if defined openhandle( $handle );
         
   }

   # create the pipes for process one
   #
   pipe( $from_parent_one, $to_child_one ) or die "pipe: $!";
   pipe( $from_child_one, $to_parent_one ) or die "pipe: $!";
   $to_child_one->autoflush(1);
   $to_parent_one->autoflush(1);

   # create the pipes for process two
   #
   pipe( $from_parent_two, $to_child_two ) or die "pipe: $!";
   pipe( $from_child_two, $to_parent_two ) or die "pipe: $!";
   $to_child_two->autoflush(1);
   $to_parent_two->autoflush(1);

   # Make the child's end of the pipes non-blocking
   #
   unblock( $from_child_one );
   unblock( $from_child_two );

   # Share a scalar between the two processes
   #
   MCE::Shared->stop();
   tie $shared, 'MCE::Shared';

   # To be able to do a "clean" restart, all possibly running
   # childs have to be terminated first
   #
   check_kill( $pid_one, 'parent' );
   check_kill( $pid_two, 'parent' );

   # Start the childs
   #
   $pid_one = run_one();
   $pid_two = run_two();
   
   # We need a few signal handlers to be able to terminate
   # the child processes (e.g. from CLI: "kill -s 10 <pid>")
   #
   $SIG{ USR1 } = sub { kill_and_restart( $pid_one, $restart_ref ) };
   #$SIG{ USR2 } = sub { $$restart_ref = 1; kill( 15 , $pid_two ) };  
+    
   $SIG{ PIPE } = $SIG{ TERM } = 'IGNORE';
   
   close( $from_parent_one );
   close( $to_parent_one );
      
   close( $from_parent_two );
   close( $to_parent_two );
   
   $shared = "Set once in parent!";
   print( "Parent: \$shared: ${shared}\n" );
 
   while ( 1 ) { 
    
      # Write a message to child one
      #
      print $to_child_one "Parent with process ID $$ for child one\n"
         or warn( "Parent on write: $!" );
      
      # Write a message to child two
      #
      print $to_child_two "Parent with process ID $$ for child two\n"
         or warn( "Parent on write: $!" );
         
      select( undef, undef, undef, 0.5 );
 
      # Read a message from child one
      #
      chomp( $line = <$from_child_one> ) or warn( "Parent on read: $!\
+n" );
      print "The parent process with PID $$ received a message: '$line
+'\n";
 
      # Read a message from child two
      #
      chomp( $line = <$from_child_two> ) or warn( "Parent on read: $!\
+n" );
      print "The parent process with PID $$ received a message: '$line
+'\n";
      
      dbg( "\$restart is " . $restart );
      
      if ( $restart ) { next START }
    
      sleep( 3 );
   }
   
   close $to_child_one;
   close $from_child_one;
   close $to_child_two;
   close $from_child_two;
   
}
   
sub run_one {
   
   my $pid;
   my $line;
   
   my $sub = 'run_one()';
   
   unblock( $from_parent_one );
   
   if ( ! defined ( $pid = fork() ) ) { die( "${sub}: $!" ) }
   
   return $pid if ( $pid );

   # close the sides of the pipes not used by the child
   #
   close $from_child_one;
   close $to_child_one;
   
   print( "Child one: \$shared: ${shared}\n" );
   
   while ( 1 ) {
      
    select( undef, undef, undef, 0.1 );
    
    # Read a message from the parent
    #
    chomp( $line = <$from_parent_one> ) or warn( "Child, on read: $!" 
+);
    print "Child one with PID $$ received a message: '$line'\n";
 
    select( undef, undef, undef, 0.1 );
     
    # Write a message to the parent
    #
    print $to_parent_one "Child one with PID $$\n"
       or warn( "Child, on write: $!" );
       
    sleep( 3 );
    
   }
   close $from_parent_one;
   close $to_parent_one;
   
   return $pid
    
}

sub run_two {
   
   my $pid;
   my $line;
   
   my $sub = 'run_two()';
   
   unblock( $from_parent_two );
   
   if ( ! defined ( $pid = fork() ) ) { die( "${sub}: $!" ) }
   
   return $pid if ( $pid );

   # close the sides of the pipes not used by the child
   #
   close $from_child_two;
   close $to_child_two;
   
   print( "Child two: \$shared: ${shared}\n" );
   
   while ( 1 ) {

    select( undef, undef, undef, 0.1 );
    
    # Read a message from the parent
    #
    chomp( $line = <$from_parent_two> ) or warn( "Child, on read: $!" 
+);
    print "Child two with PID $$ received a message: '$line'\n";

    select( undef, undef, undef, 0.1 );
    
    # Write a message to the parent
    #
    print $to_parent_two "Child two with PID $$\n"
       or warn( "Child, on write: $!" );
       
    sleep( 3 );
    
   }
   close $from_parent_two;
   close $to_parent_two;
    
}

sub unblock {
   
   my $handle = shift;
   my $flags = '';
   my $sub = 'unblock()';

   $flags = fcntl( $handle, F_GETFL, 0 )
         or die( "${sub}:  Could not get flags from pipe handle \: $!\
+n" );
      
   fcntl( $handle, F_SETFL, $flags | O_NONBLOCK )
         or die( "${sub}:  Could not set flags for pipe handle: $!\n" 
+);
         
   return;
         
}

sub dbg {
   
   my $dbg_msg = shift();
   if ( $debug ) {
      
      print( "DEBUG: ${dbg_msg}" . "\n" );
      
   }

}

sub check_kill {

   my ( $pid, $caller_id ) = @_;
   my $res_pid;

   if ( defined $pid ) {

      $res_pid = waitpid( $pid, WNOHANG );

      die( "waitpid: $!" ) unless $! eq '';
      if ( $res_pid == -1 ) {

         die( "${caller_id}: Error when checking existance of child pr
+ocess "
              . "with PID ${pid}\n" );
                 
      }
      elsif ( $res_pid == 0 ) {
            
         kill( 15, $pid );
            
      }
      
   }
            
   return $res_pid;
}

sub kill_and_restart{
   
   my ( $pid, $restart_ref ) = @_;
   
   kill( 15, $pid );
   
   $$restart_ref = 1;
   
   return;
   
}
[download]

Comment on Influencing control flow using a signal handler Download Code

Replies are listed 'Best First'.

Re: Influencing control flow using a signal handler
by Athanasius (Archbishop) on Nov 03, 2016 at 07:44 UTC

Hello Bloehdian,

This isn’t an answer to your question, just something I noticed while looking at your code:

...
my $from_parent_one;
my $to_child_one;
my $from_child_one;
my $to_parent_one;

my $from_parent_two;
my $to_child_two;
my $from_child_two;
my $to_parent_two;

my @pipe_handles = ( $from_parent_one,
                     $to_child_one,
                     $from_child_one,
                     $to_parent_one,
                     $from_parent_two,
                     $to_child_two,
                     $from_child_two,
                     $to_parent_two );
...
START: while ( 1 ) {
   ...
   # To be sure possibly remaining open pipe handles
   # are close before creating new ones
   #
   foreach my $handle ( @pipe_handles ) {

      close( $handle ) if defined openhandle( $handle );
         
   }
   ...
[download]

You initialise the array @pipe_handles with the contents of the variables $from_parent_one, $to_child_one, etc. Since these variables have themselves not yet been initialised, @pipe_handles contains (undef, undef, undef, undef, undef, undef, undef, undef) — and is never updated. I assume you intended to store variable references?

my @pipe_handles = \( $from_parent_one,
                      $to_child_one,
                      $from_child_one,
                      $to_parent_one,
                      $from_parent_two,
                      $to_child_two,
                      $from_child_two,
                      $to_parent_two );
...
   foreach my $handle ( @pipe_handles ) {

      close( $$handle ) if defined openhandle( $$handle );
         
   }
[download]

Hope that helps,

Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]

Re: Influencing control flow using a signal handler
by afoken (Chancellor) on Nov 03, 2016 at 07:42 UTC

After kill()ing one child, the parent process should kill the remaining child using a the subroutine check_kill() and create to new child processes. This should be done by leaving the inner while(1), in which the parent does it's work, and start a new iteration of the outer while (using the label START).

My idea was to set the variable $restart to a true value when the signal arrives, so that the inner loop is left on "next START".

Restart of the two childs HAVE to be done by reiterating the outer loop, the control flow is fixed.

But: How can I reach this using the signal handler?

I don't see a handler for SIGCHLD in your code. Unix sends the parent process a SIGCHLD when a child process has exited, no matter how (clean exit, crash, unhandled signal). The parent process should call wait or waitpid to get the exit reason (clean, crash, signal), the exit code, and the PID of the exited process; this is commonly called reaping. See perlipc for details.

The usual way to handle several childs is to keep track of all forked, unreaped child processes as a hash using PIDs as keys. Hash values are not relevant, can be used for application-specific purposes. When you fork a new process, store its PID in the hash. A handler for SIGCHLD calls waitpid(-1, WNOHANG) until it returns a non-positive value. A positive return value is the PID of an exited child process, the exit information is available in $?. Remove that PID from the hash, maybe store the exit information elsewhere.

To keep a fixed number of child processes running, make the parent process count the elements in the hash, and fork new child processes until the desired number has been reached. sleep for a long time if there is nothing to do. Any signal will interrupt sleep, so when sleep returns, either a long time has passed or at least one child process has exited. Alternatively, call wait and remove the returned PID from the hash.

To kill all children when one child has exited (why?), do something very similar: Change the SIGCHLD handler so that it first removes all exited processes from the hash, then - still from within the handler - kill all remaining processes from the hash. This will cause several new SIGCHLDs, so after some time, the hash will be empty. Then, and only then, restart a new set of child processes from the main program.

Updates:

1. Note that Unix does not send the parent process one SIGCHLD per exited child process. SIGCHLD is sent if at least one child process has exited. In english: SIGCHLD does not mean "a child process has exited", it means "at least one of the child processes has exited". That's why you need a loop around waitpid in the SIGCHLD handler.

2. die( "waitpid: $!" ) unless $! eq '' looks wrong. Comparing $! a.k.a. $ERRNO to the empty string is suspicious, I would use $! in boolean context instead. And ~~waidpid~~ waitpid should not set $! at all. At least the documentation does not mention that waitpid sets $!.

3. kill( 15, $pid ) has a magic number. Yes, any sane Unix assigns SIGTERM to the ID 15. But it's hard to remember. Linux has 64 signals. Why should I learn all that numbers by heart? Just use the signal name: kill(TERM => $pid) or kill('TERM',$pid).

Fixed a typo in 2. - thanks, kcott

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

[reply]
[d/l]
[select]

Re: Influencing control flow using a signal handler
by tybalt89 (Monsignor) on Nov 03, 2016 at 10:32 UTC

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1175183

use strict;
use warnings;
use IO::Select;

my $count = 1;

while(1)
  {
  print "parent starting\n";
  my $more = 1;
  $SIG{$_} = sub {$more = 0} for qw( CHLD PIPE USR1 USR2 );

  my @pids = map runchild($_), qw( one two );
  my $sel = IO::Select->new( map $_->[3], @pids );

  while( $more )
    {
    print "parent loop $$\n";
    print { $_->[2] } "message @{[$count++]} parent to $_->[1]\n"
      for @pids;
    for my $fh ( $sel->can_read(10) )
      {
      sysread $fh, my $buffer, 1024;
      print "parent got $buffer";
      }
    sleep 5;
    }
  kill 'TERM', map $_->[0], @pids;
  1 while wait > 0; # reap all children
  }

sub runchild
  {
  my $me = shift;
  pipe( my $from_parent, my $to_child );
  pipe( my $from_child, my $to_parent );
  $to_parent->autoflush(1);
  $to_child->autoflush(1);
  if( my $pid = fork )
    {
    close $from_parent;
    close $to_parent;
    return [ $pid, $me, $to_child, $from_child ];
    }
  elsif( defined $pid )
    {
    close $from_child;
    close $to_child;
    my $sel = IO::Select->new( $from_parent );
    my $more = 1;
    $SIG{TERM} = sub {$more = 0};
    while( $more )
      {
      print "child $me loop $$\n";
      for my $fh ( $sel->can_read(11) )
        {
        sysread $fh, my $buffer, 1024 or die "$me: sysread failed $!";
        print "child $me got $buffer";
        sleep 1;
        print $to_parent "reply from $me for $buffer";
        }
      }
    die "child $me exiting\n";
    }
  else
    {
    die "$! on fork for $me";
    }
  }
[download]

[reply]
[d/l]

Re: Influencing control flow using a signal handler
by Bloehdian (Beadle) on Nov 05, 2016 at 19:41 UTC

Hello folks,

You invested quite a lot of time into my silly problems. :-)

I appreciate this.

@Athanasius: I changed the script accordingly. THX.

@tybalt89: Your solution looks very professional. I think I will borrow one or the other line in later versions (and come back with questions I guess).

But first I would like to understand why my code does not work as expected.

I am able to terminate child number one without problems, but the prog fails to restart the childs. On submitting SIGUSR1 to the parent, the child is killed as expected but the parent as well, as the sample output tells us:

Child two with PID 23317 received a message: 'Parent with process ID 2
+3314 for child two'
Child one with PID 23316 received a message: 'Parent with process ID 2
+3314 for child one'
The parent process with PID 23314 received a message: 'Child one with 
+PID 23316'
The parent process with PID 23314 received a message: 'Child two with 
+PID 23317'
DEBUG: $restart is 0
Child two with PID 23317 received a message: 'Parent with process ID 2
+3314 for child two'
Child one with PID 23316 received a message: 'Parent with process ID 2
+3314 for child one'
kill_and_restart: $restart is 0, $pid is 23316
kill_and_restart: $restart is 1
[download]

Repeating the test reveals that the program is NOT terminated at the same code line each time, e.g., I was able to get the message "(Re-)Starting ..." as the last line output.

But the expected behaviour is: parent keeps on running, kills the remaining child and gives birth to two new childs.

What do I miss out?

Cheers

Bloedian

[reply]
[d/l]