From: Bill Erickson <berick@esilibrary.com>
Date: Tue, 5 Aug 2014 13:59:30 +0000 (-0400)
Subject: Track pending MUX logins via memcache
X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=1ff0ef74bbdfe2c7be58e00ca89e3c163fda8475;p=working%2FSIPServer.git

Track pending MUX logins via memcache

When a SIP child process is spawned to handle a new connection login,
the pending login is tracked in the parent process (by PID) and the
child indicates to the parent that the login has succeeded by storing
login success/failure plus some state information in memcache.  Any time
the parent wakes up to process a message, it checks for completed logins
so they can be resolved as OK in the parent and the state information
is extracted and stored for future conversation with the resolved client.

Signed-off-by: Bill Erickson <berick@esilibrary.com>
---

diff --git a/SIPServer.pm b/SIPServer.pm
index 46f8996..316c234 100644
--- a/SIPServer.pm
+++ b/SIPServer.pm
@@ -35,17 +35,13 @@ use Data::Dumper;		# For debugging
 require UNIVERSAL::require;
 use POSIX qw/:sys_wait_h :errno_h/;
 
-#use Sip qw(readline);
+use Sip qw($protocol_version);
 use Sip::Constants qw(:all);
 use Sip::Configuration;
 use Sip::Checksum qw(checksum verify_cksum);
 use Sip::MsgType;
 
-use File::Queue;
-use FreezeThaw qw(freeze thaw);
-
-my $mp_fifo = File::Queue->new( File => "/tmp/SIPServer.mulitplex-fifo.$$" );
-END { $mp_fifo->delete };
+use Cache::Memcached;
 
 use constant LOG_SIP => "local6"; # Local alias for the logging facility
 
@@ -120,6 +116,14 @@ if (defined($config->{'server-params'})) {
 
 print Dumper(@parms);
 
+# initialize all remaining global variables before 
+# going into listen mode.
+my %kid_hash;
+my $kid_count = 0;
+my $cache;
+my @pending_connections;
+my %active_connections;
+
 #
 # This is the main event.
 SIPServer->run(@parms);
@@ -175,8 +179,6 @@ sub process_request {
 # an incoming connection request when the peronsality is 
 # Multiplex.
 
-my %kid_hash;
-my $kid_count = 0;
 
 sub REAPER {
   for (keys(%kid_hash)) {
@@ -189,21 +191,62 @@ sub REAPER {
   $SIG{CHLD} = sub { REAPER() };
 }
 
-my %active_connections;
-sub PERMAFROST {
-    while (my $login = $mp_fifo->deq) {
-        ($login) = thaw($login);
-
-        my $c = $$login{id};
-        if ($$login{success}) {
-            for my $p (keys %{ $$login{net_server_parts} }) {
-                $active_connections{$c}{net_server}{$p} = 
-                    $$login{net_server_parts}{$p};
-            }
-        } else {
-            delete $active_connections{$c};
-        }
+sub init_cache {
+    return $cache if $cache;
+
+    if (!$config->{cache}) {
+        syslog('LOG_ERR', "Cache servers needed");
+        return;
     }
+    my $servers = $config->{cache}->{server};
+    syslog('LOG_DEBUG', "Cache servers: @$servers");
+
+    $cache = Cache::Memcached->new({servers => $servers}) or
+        syslog('LOG_ERR', "Unable to initialize memcache: @$servers");
+
+    return $cache;
+}
+
+# In the parent, pending connections are tracked as an array of PIDs.
+# As each child process completes the login dance, it plops some
+# info into memcache for us to pickup and copy into our active
+# connections.  No memcache entry means the child login dance
+# is still in progress.
+sub check_pending_connections {
+    return unless @pending_connections;
+
+    init_cache();
+
+    syslog('LOG_DEBUG', 
+        "multi: pending connections to inspect: @pending_connections");
+
+    # get_multi will return all completed login blobs
+    my @keys = map { "sip_pending_auth_$_" } @pending_connections;
+    my $values = $cache->get_multi(@keys);
+
+    for my $key (keys %$values) {
+    
+        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};
+        delete $active_connections{$id} unless $VAR1->{success};
+
+        # clean up ---
+
+        (my $pid = $key) =~ s/sip_pending_auth_(\d+)/$1/g;
+
+        syslog('LOG_DEBUG', 
+            "multi: pending connection for pid=$pid / id=$id resolved");
+
+        $cache->delete($key);
+        @pending_connections = grep {$_ != $pid} @pending_connections;
+    }
+
+    syslog('LOG_DEBUG', 
+        "multi: connections still pending after check: @pending_connections")
+        if @pending_connections;
 }
 
 sub mux_input {
@@ -224,7 +267,7 @@ sub mux_input {
     REAPER();
 
     # and process any pending logins
-    PERMAFROST();
+    check_pending_connections();
 
     my $c = scalar(keys %active_connections);
     syslog("LOG_DEBUG", "multi: new active connection; $c total");
@@ -292,20 +335,33 @@ sub mux_input {
                 # Stash the ILS module somewhere handy for later
                 $self->{ils} = ref($self->{ils});
             }
-
-            $mp_fifo->enq(
-                freeze({
-                    id => $conn_id,
-                    success => $success,
-                    net_server_parts => {
-                        map { ($_ => $$self{$_}) } qw/ils state institution account/
-                    }
-                })
+            
+            my $info = {
+                id => $conn_id,
+                success => $success,
+                net_server_parts => {
+                    map { ($_ => $$self{$_}) } qw/ils state institution account/
+                }
+            };
+
+            init_cache()->set(
+                "sip_pending_auth_$$", 
+                Data::Dumper->Dump([$info]),
+                # Our cache entry is only inspected when the parent process
+                # wakes up from an inbound request.  If this is the last child
+                # to connect before a long period of inactivity, our cache
+                # entry may sit unnattended for some time, hence the
+                # 12 hour cache timeout.  XXX: make it configurable?
+                43200 # 12 hours
             );
     
             exit(0);
+
+        } else {
+            push(@pending_connections, $pid);
         }
 
+        # nothing else for the parent to do until login completes
         return; # NEXT CUSTOMER PLEASE STEP UP
     }
 
@@ -320,8 +376,15 @@ sub mux_input {
     if ($pid == 0) { # in kid
 
         # build the connection we deleted after logging in
+        $self->{ils}->use;
         $self->{ils} = $self->{ils}->new($self->{institution}, $self->{account}, $self->{state});
 
+        # MUX mode only works with protocol version 2, because it assumes
+        # a SIP login has occured.  However, since the login occured 
+        # within a different now-dead process, the previously modified
+        # protocol_version is lost.  Re-apply it globally here.
+        $protocol_version = 2;
+
         if (!$self->{ils}) {
             syslog('LOG_ERR', "Unable to build ILS module in mux child");
             exit(0);
diff --git a/Sip/Configuration.pm b/Sip/Configuration.pm
index a673fb9..ce9144e 100644
--- a/Sip/Configuration.pm
+++ b/Sip/Configuration.pm
@@ -38,14 +38,14 @@ my $parser = new XML::Simple(
     KeyAttr => {
         login       => '+id',
         institution => '+id',
-        service     => '+port'
+        service     => '+port',
     },
     GroupTags => {
         listeners    => 'service',
         accounts     => 'login',
         institutions => 'institution',
     },
-    ForceArray => [ 'service', 'login', 'institution' ],
+    ForceArray => [ 'service', 'login', 'institution', 'server' ],
     ValueAttr  => {
         'error-detect' => 'enabled',
         'timeout'      => 'value',