LP#1339190 SIP Multiplex repairs

 * mux_input params / string handling - no reading from $fh
 * until proven otherwise, capture mux $fh for later writing -- may be
   unnecessary.
 * minor thinkos
 * remove output_fh tracking.  It's not needed.
 * write output Sip::write_msg via POSIX::write to bypass IO::Multiplex
   output buffer caching.  This is needed since SIP child procs never
   return from mux_input (they exit) so the cached output is never
   sent to the client.
* Use the stringified file handle as the connection ID instead of the
  fileno.  This allows us to find the connection during mux_close,
  where, since the file handle has already been close, fileno($fh)
  returns undef.
* Don't allow a connection-level die() to affect the parent process.  The
 parent process must be highly resilient.

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

diff --git a/SIPServer.pm b/SIPServer.pm
index 1572895..8324ed6 100644 (file)
--- a/SIPServer.pm
+++ b/SIPServer.pm
@@ -29,9 +29,11 @@ use Net::Server::Multiplex;
 use Net::Server::PreFork;
 use Net::Server::Proto;
 use IO::Socket::INET;
+use IO::String;
 use Socket qw(:crlf);
 use Data::Dumper;              # For debugging
 require UNIVERSAL::require;
+use POSIX qw/:sys_wait_h :errno_h/;
 
 #use Sip qw(readline);
 use Sip::Constants qw(:all);
@@ -168,28 +170,34 @@ my $kid_count;
 
 sub REAPER {
   for (keys(%kid_hash)) {
-    if ( my $reaped = waitpid($_, &WNOHANG) > 0 ) {
+    if ( my $reaped = waitpid($_, WNOHANG) > 0 ) {
       # Mourning... done.
       $kid_count--;
       delete $kid_hash{$_};
     }
   }
-  $SIG{CHLD} = &REAPER();
+  $SIG{CHLD} = sub { REAPER() };
 }
 
 my %active_connections;
 sub mux_input {
     my $mself = shift;
     my $mux = shift;
-    my $fh = shift;
+    my $mux_fh = shift;
+    my $str_ref = shift;
 
-    my $self;
-    my $conn_id = fileno($fh);
+    # clone the mux string into a file handle
+    my $str_fh = IO::String->new(''.$$str_ref);
+
+    # clear read data from the mux string ref
+    $$str_ref = '';
+
+    my $conn_id = ''.$mux_fh;
 
     # check for kids that went away
     REAPER();
 
-
+    my $self;
     if (!$active_connections{$conn_id}) { # Brand new connection, log them in
         $self = $mself->{net_server};
 
@@ -208,7 +216,8 @@ sub mux_input {
         if (! defined($self->{service})) {
             syslog( "LOG_ERR", "process_request: Unrecognized server connection: %s:%s/%s",
                 $sockaddr, $port, $proto );
-            die "process_request: Bad server connection";
+            syslog('LOG_ERR', "process_request: Bad server connection");
+            return;
         }
     
         my $transport = $transports{ $self->{service}->{transport} };
@@ -218,7 +227,11 @@ sub mux_input {
             return;
         }
 
-        &$transport($self, $fh);
+        eval { &$transport($self, $str_fh) };
+        if ($@) {
+            syslog('LOG_ERR', "ILS login error: $@");
+            return;
+        }
 
         $active_connections{$conn_id} =
             { id         => $conn_id,
@@ -233,20 +246,27 @@ sub mux_input {
         $active_connections{$conn_id}->{ils} = ref($self->{ils});
         delete $$self{ils};
 
+        my $c = scalar(keys %active_connections);
+        syslog("LOG_DEBUG", "multi: new active connection; $c total");
+
         return;
     }
 
     $self = $active_connections{$conn_id}->{net_server};
 
     my $pid = fork();
-    die "Cannot fork: $!" unless (defined($pid) && $pid > -1);
+    if (!defined($pid) or $pid < 0) {
+        syslog('LOG_ERR', "Unable to fork new child process $!");
+        return;
+    }
 
     if ($pid == 0) { # in kid
 
         # build the connection we deleted after logging in
         $self->{ils} = $active_connections{$conn_id}->{ils}->new($self->{institution}, $self->{account});
 
-        my $input = Sip::read_SIP_packet($fh);
+        # build the connection we deleted after logging in
+        my $input = Sip::read_SIP_packet($str_fh);
         $input =~ s/[\r\n]+$//sm;    # Strip off any trailing line ends
 
         my $status = Sip::MsgType::handle($input, $self, '');
@@ -261,17 +281,27 @@ sub mux_input {
     } else { # in parent
         $kid_count++;
         $kid_hash{$pid} = 1;
+        syslog("LOG_DEBUG", "multi: $conn_id forked child $pid; $kid_count total");
     } 
+}
 
+# client disconnected, remove the active connection
+sub mux_close {
+    my ($self, $mux, $fh) = @_;
+    delete $active_connections{''.$fh};
+    syslog("LOG_DEBUG", "multi: cleaning up child: $fh; ". 
+        scalar(keys %active_connections)." remain");
 }
 
+
 #
 # Transports
 #
 
 sub raw_transport {
     my $self = shift;
-    my $fh ||= *STDIN;
+    my $fh = shift || *STDIN;
+
     my ($uid, $pwd);
     my $input;
     my $service = $self->{service};
@@ -319,12 +349,12 @@ sub raw_transport {
     syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
         $self->{account}->{id},
         $self->{account}->{institution});
-
 }
 
 sub telnet_transport {
     my $self = shift;
-    my $fh ||= *STDIN;
+    my $fh = shift || *STDIN;
+
     my ($uid, $pwd);
     my $strikes = 3;
     my $account = undef;

diff --git a/Sip.pm b/Sip.pm
index a687cd7..35ba419 100644 (file)
--- a/Sip.pm
+++ b/Sip.pm
@@ -241,14 +241,16 @@ sub write_msg {
         $msg .= checksum($msg);
     }
 
+    my $outmsg = "$msg\r";
 
     if ($file) {
-        print $file "$msg\r";
+        print $file $outmsg;
     } else {
-        print "$msg\r";
-        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
+        my $rv = POSIX::write(fileno(STDOUT), $outmsg, length($outmsg));
+        syslog("LOG_ERR", "Error writing to STDOUT $!") unless $rv;
     }
 
+    syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
     $last_response = $msg;
 }