Found that kill(-sig, pid) sometimes fails with

'process id not found' although a previous kill(0, pid)
succeeded. This is a race condition condition caused
by a newly forked child that hasn't called setsid() yet
and therefore its new process group id doesn't exist yet,
although the child responds to poll(). kill() now
deals with this case.

Changes

@@ -5,6 +5,14 @@
           From 1.29:
                      [RT 69782] Zefram reported race condition in t/sh-c.t,
                      fixed by adding polling loop.
+
+                     Found that kill(-sig, pid) sometimes fails with 
+                     'process id not found' although a previous kill(0, pid) 
+                     succeeded. This is a race condition condition caused
+                     by a newly forked child that hasn't called setsid() yet
+                     and therefore its new process group id doesn't exist yet,
+                     although the child responds to poll(). kill() now
+                     deals with this case.
           From 1.28:
                      [RT 69103] Typo fix by Salvatore Bonaccorso
                      Added support for processes called via 'sh -c' by

Simple.pm

@@ -243,6 +243,15 @@ sub start {
   return 0 unless defined $self->{'pid'};  #   return Error if fork failed
 
   if($self->{pid} == 0) { # Child
+        # Mark it as process group leader, so that we can kill
+        # the process group later. Note that there's a race condition
+        # here because there's a window in time (while you're reading
+        # this comment) between child startup and its new process group 
+        # id being defined. This means that killpg() to the child during 
+        # this time frame will fail. Proc::Simple's kill() method deals l
+        # with it, see comments there.
+      POSIX::setsid();
+      $self->dprt("setsid called ($$)");
 
       if (defined $self->{'redirect_stderr'}) {
         $self->dprt("STDERR -> $self->{'redirect_stderr'}");
@@ -256,13 +265,11 @@ sub start {
         autoflush STDOUT 1 ;
       }
 
-        # Mark it as process group leader, so that we can kill
-        # the process group later.
-      POSIX::setsid();
-
       if(ref($func) eq "CODE") {
-        $func->(@params); exit 0;            # Start perl subroutine
+          $self->dprt("Launching code");
+          $func->(@params); exit 0;            # Start perl subroutine
       } else {
+          $self->dprt("Launching $func @params");
           exec $func, @params;       # Start shell process
           exit 0;                    # In case something goes wrong
       }
@@ -297,18 +304,20 @@ and returns I<1> if it is, I<0> if it's not.
 sub poll {
   my $self = shift;
 
+  $self->dprt("Polling");
+
   # There's some weirdness going on with the signal handler. 
   # It runs into timing problems, so let's have poll() call
   # the REAPER every time to make sure we're getting rid of 
   # defuncts.
   $self->THE_REAPER();
 
-  if(defined($self->{'pid'})) {
-      if(kill(0, $self->{'pid'})) {
-          $self->dprt("POLL($self->{'pid'}) RESPONDING");
-	      return 1;
+  if(defined($self->{pid})) {
+      if(CORE::kill(0, $self->{pid})) {
+          $self->dprt("POLL($self->{pid}) RESPONDING");
+          return 1;
       } else {
-          $self->dprt("POLL($self->{'pid'}) NOT RESPONDING");
+          $self->dprt("POLL($self->{pid}) NOT RESPONDING");
       }
   } else {
      $self->dprt("POLL(NOT DEFINED)");
@@ -353,18 +362,28 @@ sub kill {
   }
 
   # Process initialized at all?
-  return 0 if !defined $self->{'pid'};
+  if( !defined $self->{'pid'} ) {
+      $self->dprt("No pid set");
+      return 0;
+  }
 
   # kill process group instead of process to make sure that shell
   # processes containing shell characters, which get launched via
   # "sh -c" are killed along with their launching shells.
   $sig = -$sig;
 
   # Send signal
-  if(kill($sig, $self->{'pid'})) {
+  if(CORE::kill($sig, $self->{'pid'})) {
       $self->dprt("KILL($sig, $self->{'pid'}) OK");
   } else {
-      $self->dprt("KILL($sig, $self->{'pid'}) failed");
+      $self->dprt("KILL($sig, $self->{'pid'}) failed ($!)");
+        # Have we hit the race condition of a newly forked child
+        # that hasn't called setsid() yet? Call kill again with 
+        # a positive sig number.
+      if( $sig and $self->poll() ) {
+          $self->dprt("We've hit the race condition, using kill(+sig) instead");
+          return CORE::kill(-$sig, $self->{'pid'});
+      }
       return 0;
   }
 
@@ -652,7 +671,10 @@ sub THE_REAPER {
 
         foreach my $pid (keys %EXIT_STATUS) {
             dprt("", "Trying to reap $pid");
-            next if defined $EXIT_STATUS{$pid};
+            if( defined $EXIT_STATUS{$pid} ) {
+                dprt("", "exit status of $pid is defined - not reaping");
+                next;
+            }
             if(my $res = waitpid($pid, $WNOHANG) > 0) {
                 # We reaped a truly running process
                 $EXIT_STATUS{$pid} = $?;
@@ -665,6 +687,7 @@ sub THE_REAPER {
     } else { 
         # If we don't have $WNOHANG, we don't have a choice anyway.
         # Just reap everything.
+        dprt("", "reap everything for lack of WNOHANG");
         $child = CORE::wait();
         $EXIT_STATUS{$child} = $?;
         $INTERVAL{$child}{'t1'} = $now;
@@ -715,7 +738,11 @@ sub cleanup {
 ######################################################################
 sub dprt {
   my $self = shift;
-  print ref($self), "> @_\n" if $Debug;
+  if($Debug) {
+      require Time::HiRes;
+      my ($seconds, $microseconds) = Time::HiRes::gettimeofday();
+      print "[$seconds.$microseconds] ", ref($self), "> @_\n";
+  }
 }
 
 ######################################################################

t/esub.t

@@ -9,21 +9,25 @@ package EmptySubclass;
 
 package Main;
 use Test::More;
-plan tests => 2;
+plan tests => 3;
 
 ###
 ### Empty Subclass test
 ###
+# Proc::Simple::debug(1);
+
 $psh  = EmptySubclass->new();
 
 ok($psh->start("sleep 10"));        # 1
 
 while(!$psh->poll) { 
     sleep 1; }
 
-ok($psh->kill());                   # 2
+ok($psh->kill()) or die;                   # 2
 
 while($psh->poll) { 
     sleep 1; }
 
+ok(1, "the end");
+
 1;

t/simple.t

@@ -17,6 +17,7 @@ plan tests => 10;
 
 ### Shell commands
 
+# Proc::Simple::debug(1);
 $psh  = Proc::Simple->new();
 
 ok($psh->start("sleep 1"));         # 1