From b0a41d3973c944259c193fb4da1dce7f0c690f70 Mon Sep 17 00:00:00 2001
From: Bill Erickson <berick@esilibrary.com>
Date: Thu, 5 Dec 2013 12:27:44 -0500
Subject: [PATCH] OpenSRF client disconnect robustification (Perl)

* Improve detection of client connection state with jabber server

  Be more aggressive in testing and responding to failed connectivity.
  It can happen in various ways, depending on what's happening to the
  jabber server (death, delay, graceful shutdown).  With these changes
  we attempt to cover all the bases and detect as early as possible that
  a connection has died, specifically when trying to create a new
  connection after one has failed.

* Do a better job of cleaning up dead connections

  Transport::PeerHandle now has a reset() action which disconnects (when
  possible) and clears the global connection reference.

Signed-off-by: Bill Erickson <berick@esilibrary.com>
Signed-off-by: Galen Charlton <gmc@esilibrary.com>
---
 src/perl/lib/OpenSRF/System.pm                         | 10 ++++++++--
 src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm    |  6 ++++++
 .../lib/OpenSRF/Transport/SlimJabber/PeerConnection.pm |  6 ++++++
 .../lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm     |  1 +
 4 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/src/perl/lib/OpenSRF/System.pm b/src/perl/lib/OpenSRF/System.pm
index 7eb7120..39aeaf9 100644
--- a/src/perl/lib/OpenSRF/System.pm
+++ b/src/perl/lib/OpenSRF/System.pm
@@ -52,7 +52,13 @@ sub bootstrap_client {
     my $self = shift;
 
     my $con = OpenSRF::Transport::PeerHandle->retrieve;
-    return if $con and $con->tcp_connected;
+    if ($con) {
+        # flush the socket to force a non-blocking read
+        # and to clear out any unanticipated leftovers
+        eval { $con->flush_socket };
+        return if $con->connected;
+        $con->reset;
+    }
 
     my %params = @_;
 
@@ -68,7 +74,7 @@ sub bootstrap_client {
 
 sub connected {
     if (my $con = OpenSRF::Transport::PeerHandle->retrieve) {
-        return 1 if $con->tcp_connected;
+        return 1 if $con->connected;
     }
     return 0;
 }
diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm
index a3f9233..dc5a1c5 100644
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm
@@ -98,6 +98,11 @@ sub tcp_connected {
     return 0;
 }
 
+sub connected {
+    my $self = shift;
+    return $self->reader->connected if $self->reader;
+    return 0;
+}
 
 
 =head2 send
@@ -210,6 +215,7 @@ the socket isn't connected.
 
 sub flush_socket {
 	my $self = shift;
+    return 0 unless $self->reader;
     return $self->reader->flush_socket;
 }
 
diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/PeerConnection.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/PeerConnection.pm
index c41517c..e4f4749 100644
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/PeerConnection.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/PeerConnection.pm
@@ -31,6 +31,12 @@ sub retrieve {
 	return $_singleton_connection;
 }
 
+sub reset {
+    return unless $_singleton_connection;
+    $_singleton_connection->disconnect;
+    $_singleton_connection = undef;
+}
+
 
 sub new {
 	my( $class, $app ) = @_;
diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
index b68e418..857bee7 100644
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
@@ -229,6 +229,7 @@ sub wait {
     if ($first_read and defined $nbytes and $nbytes == 0) {
         # if the first read on an active socket is 0 bytes, 
         # the socket has been disconnected from the remote end. 
+        $self->{stream_state} = DISCONNECTED;
         $logger->error("Disconnected from Jabber server");
         throw OpenSRF::EX::Jabber("Disconnected from Jabber server");
     }
-- 
2.43.2