From 10976d58bd600ea8cb9530d5082cb33a6e4cc990 Mon Sep 17 00:00:00 2001
From: Bill Erickson <berick@esilibrary.com>
Date: Tue, 19 Aug 2014 13:41:04 -0400
Subject: [PATCH] LP#1339190 state maintenance improvements

* avoid using the same net_server object as the per-child state data
  container.
* improve/simplify state date caching by using the connection ID as
  the key instead of the pid.
* use the net::server blessed sig_chld for child process pipe
* management.

Signed-off-by: Bill Erickson <berick@esilibrary.com>
---
 SIPServer.pm | 51 +++++++++++++++++++++++++++++----------------------
 1 file changed, 29 insertions(+), 22 deletions(-)

diff --git a/SIPServer.pm b/SIPServer.pm
index e61a7b8..b169de7 100755
--- a/SIPServer.pm
+++ b/SIPServer.pm
@@ -232,55 +232,63 @@ sub check_pending_connections {
     my $values = $cache->get_multi(@keys);
 
     for my $key (keys %$values) {
-        (my $pid = $key) =~ s/sip_pending_auth_(\d+)/$1/g;
-
         my $VAR1; # for Dump() -> eval;
         eval $values->{$key}; # Data::Dumper->Dump string
 
-        my $id = $VAR1->{id};
-        $active_connections{$id}{net_server}{$_} = $VAR1->{net_server_parts}{$_}
-            for (keys %{$VAR1->{net_server_parts}});
+        my $id = $VAR1->{id}; # conn_id
+        $active_connections{$id}{net_server_parts} = $VAR1->{net_server_parts};
 
         if ($VAR1->{success}) {
-
-            if ($active_connections{$id}{net_server}{state}) {
+            if ($active_connections{$id}{net_server_parts}{state}) {
                 local $Data::Dumper::Indent = 0;
-                syslog('LOG_DEBUG', "multi: pid=$pid id=$id has state: ".
-                    Dumper($active_connections{$id}{net_server}{state}));
+                syslog('LOG_DEBUG', "multi: conn_id=$id has state: ".
+                    Dumper($active_connections{$id}{net_server_parts}{state}));
             }
 
         } else {
-            syslog('LOG_INFO', "Child $pid / $id failed SIP login; removing connection");
+            syslog('LOG_INFO', "Child $id failed SIP login; removing connection");
             delete $active_connections{$id};
         }
 
         # clean up ---
 
         syslog('LOG_DEBUG', 
-            "multi: pending connection for pid=$pid / id=$id resolved");
+            "multi: pending connection for conn_id=$id resolved");
         $cache->delete($key);
-        @pending_connections = grep {$_ != $pid} @pending_connections;
+        @pending_connections = grep {$_ ne $id} @pending_connections;
     }
 
     syslog('LOG_DEBUG', 
         "multi: connections still pending after check: @pending_connections")
         if @pending_connections;
+
+    if (0) {
+        # useful for debugging connection-specific state information
+        local $Data::Dumper::Indent = 0;
+        for my $conn_id (keys %active_connections) {
+            syslog('LOG_DEBUG', "Connection $conn_id has state "
+                .Dumper($active_connections{$conn_id}{net_server_parts}{state}));
+        }
+    }
 }
 
-sub REAPER {
+sub sig_chld {
     for (keys(%kid_hash)) {
         if ( my $reaped = waitpid($_, WNOHANG) > 0 ) {
+            syslog('LOG_DEBUG', "Reaping child $_");
             # Mourning... done.
             $kid_count--;
+            # note: in some cases (when the primary connection is severed),
+            # the active connection is cleaned up in mux_close.  
             if ($active_connections{$kid_hash{$_}}) {
                 if ($active_connections{$kid_hash{$_}}{worker_pipe}) {
+                    syslog('LOG_DEBUG', "Closing worker pipe after timeout for: $kid_hash{$_}");
                     delete $active_connections{$kid_hash{$_}}{worker_pipe};
                 }
             }
             delete $kid_hash{$_};
         }
     }
-    $SIG{CHLD} = sub { REAPER() };
 }
 
 sub mux_input {
@@ -302,9 +310,6 @@ sub mux_input {
         syslog('LOG_DEBUG', "Inbound msg on existing connection: $conn_id");
     }
 
-    # check for kids that went away
-    REAPER();
-
     # and process any pending logins
     check_pending_connections();
 
@@ -400,7 +405,7 @@ sub mux_input {
                 }
 
                 init_cache()->set(
-                    "sip_pending_auth_$$", 
+                    "sip_pending_auth_$conn_id", 
                     Data::Dumper->Dump([$cache_data]),
                     # Our cache entry is only inspected when the parent process
                     # wakes up from an inbound request.  If this is the last child
@@ -431,7 +436,7 @@ sub mux_input {
             $fh->writer;
             $fh->autoflush;
             print $fh $$str_ref;
-            push(@pending_connections, $pid);
+            push(@pending_connections, $conn_id);
             $kid_hash{$pid} = $conn_id;
             $kid_count++;
         }
@@ -439,7 +444,8 @@ sub mux_input {
     } else {
 
         $self = $active_connections{$conn_id}->{net_server};
-    
+        my $ns_parts = $active_connections{$conn_id}->{net_server_parts};
+
         if ($active_connections{$conn_id}{worker_pipe}) {
             syslog('LOG_DEBUG', "multi: parent writing msg to existing child process");
             my $fh = $active_connections{$conn_id}{worker_pipe};
@@ -461,8 +467,9 @@ sub mux_input {
                 syslog("LOG_DEBUG", "multi: $conn_id to be processed by child $$");
         
                 # build the connection we deleted after logging in
-                $self->{ils}->use; # module name in the parent
-                $self->{ils} = $self->{ils}->new($self->{institution}, $self->{account}, $self->{state});
+                $ns_parts->{ils}->use; # module name in the parent
+                $self->{ils} = $ns_parts->{ils}->new(
+                    $ns_parts->{institution}, $ns_parts->{account}, $ns_parts->{state});
         
                 # MUX mode only works with protocol version 2, because it assumes
                 # a SIP login has occured.  However, since the login occured 
-- 
2.11.0