From ce82b807e5e668874f6b222c38b43ae47faf9c95 Mon Sep 17 00:00:00 2001
From: Mike Rylander <mrylander@gmail.com>
Date: Fri, 25 Jul 2014 14:30:11 -0400
Subject: [PATCH] LP#1339190 Optimistic login using fork-and-check over
 File::Queue

Signed-off-by: Mike Rylander <mrylander@gmail.com>
Signed-off-by: Bill Erickson <berick@esilibrary.com>
---
 SIPServer.pm | 78 ++++++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 57 insertions(+), 21 deletions(-)

diff --git a/SIPServer.pm b/SIPServer.pm
index 669f6fd..0538f7e 100644
--- a/SIPServer.pm
+++ b/SIPServer.pm
@@ -41,6 +41,12 @@ use Sip::Configuration;
 use Sip::Checksum qw(checksum verify_cksum);
 use Sip::MsgType;
 
+use File::Queue;
+use Storable qw(freeze thaw);
+
+my $mp_fifo = new File::Queue ( "/tmp/SIPServer.mulitplex-fifo.$$");
+END { $mp_fifo->delete };
+
 use constant LOG_SIP => "local6"; # Local alias for the logging facility
 
 our $VERSION = 0.02;
@@ -184,6 +190,17 @@ sub REAPER {
 }
 
 my %active_connections;
+sub PERMAFROST {
+    while (my $login = $mp_fifo->deq) {
+        $login = thaw($login);
+        if ($$login{success}) {
+            $active_connections{$$login{id}} = $login;
+        } else {
+            delete $active_connections{$$login{id}};
+        }
+    }
+}
+
 sub mux_input {
     my $mself = shift;
     my $mux = shift;
@@ -201,6 +218,12 @@ sub mux_input {
     # check for kids that went away
     REAPER();
 
+    # and process any pending logins
+    PERMAFROST();
+
+    my $c = scalar(keys %active_connections);
+    syslog("LOG_DEBUG", "multi: new active connection; $c total");
+
     if ($kid_count >= $max_concurrent) {
         # XXX should we say something to the client? maybe wait and try again?
         syslog('LOG_ERR', "Unwilling to fork new child process, at least $max_concurrent already ongoing");
@@ -237,33 +260,45 @@ sub mux_input {
             return;
         }
 
-        eval { &$transport($self, $str_fh) };
-        if ($@) {
-            syslog('LOG_ERR', "ILS login error: $@");
+        # We stick this here, assuming success. Cleanup comes later via PERMAFROST().
+        $active_connections{$conn_id} = { id => $conn_id, transport => $transport };
+ 
+        my $pid = fork();
+        if (!defined($pid) or $pid < 0) {
+            syslog('LOG_ERR', "Unable to fork new child process $!");
             return;
         }
 
-        $active_connections{$conn_id} =
-            { id         => $conn_id,
-              transport  => $transport,
-              net_server => bless({%$self}, ref($self))
-            };
-    
-        # Evergreen, at least, needs a chance to clean up before forking for other requests
-        $self->{ils}->disconnect() if (UNIVERSAL::can($self->{ils},'disconnect'));
-
-        # Stash the ILS module somewhere handy for later
-        $active_connections{$conn_id}->{ils} = ref($self->{ils});
-
-        # And, if the ILS module wants to save some state, allow that
-        $active_connections{$conn_id}->{state} = $self->{ils}->state() if (UNIVERSAL::can($self->{ils},'state'));;
+        if ($pid == 0) { # in kid
 
-        delete $$self{ils};
+            eval { &$transport($self, $str_fh) };
 
-        my $c = scalar(keys %active_connections);
-        syslog("LOG_DEBUG", "multi: new active connection; $c total");
+            my $success = 1;
+            if ($@) {
+                syslog('LOG_ERR', "ILS login error: $@");
+                $success = 0;
+                exit(0);
+            }
+    
+            # Evergreen, at least, needs a chance to clean up before forking for other requests
+            $self->{ils}->disconnect() if (UNIVERSAL::can($self->{ils},'disconnect'));
+
+            # Stash the ILS module somewhere handy for later
+            $self->{ils} = ref($self->{ils});
+
+            $mp_fifo->enq(
+                freeze({
+                    id => $conn_id,
+                    success => $success,
+                    transport  => $transport,
+                    net_server => bless({%$self}, ref($self))
+                })
+            );
+    
+            exit(0);
+        }
 
-        return;
+        return; # NEXT CUSTOMER PLEASE STEP UP
     }
 
     $self = $active_connections{$conn_id}->{net_server};
@@ -351,6 +386,7 @@ sub raw_transport {
                 die 'raw_transport: sending SC status before login not enabled, exiting';
             }
             Sip::MsgType::handle($input, $self, SC_STATUS);
+            $strikes++; # it's allowed, don't charge for it
             next;
         }
         last if Sip::MsgType::handle($input, $self, LOGIN);
-- 
2.11.0