LP#1953044: defer final cleanup of reaped children

This patch makes OpenSRF::Server->reap_children() put
the objects representing reaped children onto a "zombie list"
for later cleanup. Doing this avoids a race condition
where ->reap_children(), when invoked via a signal, can destroy
a child object out from underneath the loop in ->check_status()
that sets up an IO::Select object to check for input from
child pipes. When this race condition is triggered, the
listener will crash with the following error and attempt
to reset itself:

  server: died with error Use of freed value in iteration
  at /usr/lib/x86_64-linux-gnu/perl/5.28/IO/Select.pm line 70.

Because the reset logic itself has some problems, this type of
failure can result in a service that appears to be active
but whose listener thinks it has more active children than
is actually the case, degrading (or preventing) responsiveness.
In particular, one symptom of this bug is observing the size
of the service's backlog queue growing even when it hasn't
actually spawned the maximum number of drones it's configured to
have.

To test
-------
[1] Fire a lot of requests at an OpenSRF service and check for
    the error listed above. On Perl 5.24 or later, this will
    eventually happen.

    To increase the chances of such an error happening quickly,
    I found that the following change to opensrf.Slooooooow.wait
    was enough to trigger the bug in a reasonable amount of
    time. (Throwing a lot of parallel requests at the service
    seems to help reduce the waiting time.)

    @@ -24,7 +24,10 @@ sub wait_for_it {
        $pause //= 1;

        $log->info("Holding for $pause seconds...");
    -    sleep($pause);
    +    #sleep($pause);
    +    select(undef, undef, undef, 0.1);
    +
    +    if (int(rand(10)) <= 5) { die; }
        $log->info("Done waiting, time to return.");
        return [$pause, @_]
    }

[2] Apply the patch and repeat step 1. This time, the error
    should not occur.

Signed-off-by: Galen Charlton <gmc@equinoxOLI.org>

diff --git a/src/perl/lib/OpenSRF/Server.pm b/src/perl/lib/OpenSRF/Server.pm
index 52c53d2..b6bed8c 100644 (file)
--- a/src/perl/lib/OpenSRF/Server.pm
+++ b/src/perl/lib/OpenSRF/Server.pm
@@ -44,6 +44,7 @@ sub new {
     $self->{routers}        = []; # list of registered routers
     $self->{active_list}    = []; # list of active children
     $self->{idle_list}      = []; # list of idle children
+    $self->{zombie_list}    = []; # list of reaped children to clean up
     $self->{sighup_pending} = [];
     $self->{pid_map}        = {}; # map of child pid to child for cleaner access
     $self->{sig_pipe}       = 0;  # true if last syswrite failed
@@ -162,6 +163,7 @@ sub run {
         my $from_network = 0;
 
         $self->check_status;
+        $self->squash_zombies;
         $self->{child_died} = 0;
 
         my $msg = shift(@max_children_msg_queue);
@@ -288,6 +290,20 @@ sub run {
 }
 
 # ----------------------------------------------------------------
+# Finish destroying objects for reaped children
+# ----------------------------------------------------------------
+sub squash_zombies {
+    my $self = shift;
+
+    my $squashed = 0;
+    while (my $child = shift @{$self->{zombie_list}}) {
+        delete $child->{$_} for keys %$child; # destroy with a vengeance
+        $squashed++;
+    }
+    $chatty and $logger->internal("server: squashed $squashed zombies");
+}
+
+# ----------------------------------------------------------------
 # Launch a new spare child or kill an extra spare child.  To
 # prevent large-scale spawning or die-offs, spawn or kill only
 # 1 process per idle maintenance loop.
@@ -504,7 +520,12 @@ sub reap_children {
 
         $self->{num_children}--;
         delete $self->{pid_map}->{$pid};
-        delete $child->{$_} for keys %$child; # destroy with a vengeance
+
+        # since we may be in the middle of check_status(),
+        # stash the remnants of the child for later cleanup
+        # after check_status() has finished; otherwise, we may crash
+        # the parent with a "Use of freed value in iteration" error
+        push @{ $self->{zombie_list} }, $child;
     }
 
     $self->spawn_children unless $shutdown;