From 9ca5c3dd2e591f48bdd0a45fe0278f95a4b17e76 Mon Sep 17 00:00:00 2001
From: Mike Rylander <mrylander@gmail.com>
Date: Thu, 4 Aug 2016 08:57:44 -0400
Subject: [PATCH 1/1] LP#1616501: teach mod_perl handlers how to detect client
 disconnects

This patch provides an API so that mod_perl handlers
that act as OpenSRF clients have a way to specify that
if the browser disconnects, to stop trying to receive
results from an XMPP request.

To invoke it, mod_perl handlers can add the following:

use OpenSRF;
...
sub hander {
...
    my $r = shift;
    OpenSRF->OSRF_APACHE_REQUEST_OBJ($r);
...

Signed-off-by: Mike Rylander <mrylander@gmail.com>
Signed-off-by: Galen Charlton <gmc@equinoxinitiative.org>
---
 src/perl/lib/OpenSRF.pm                       | 17 ++++++++++++
 .../Transport/SlimJabber/XMPPReader.pm        | 26 ++++++++++++++++++-
 2 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/src/perl/lib/OpenSRF.pm b/src/perl/lib/OpenSRF.pm
index b577ecd..33b8c83 100644
--- a/src/perl/lib/OpenSRF.pm
+++ b/src/perl/lib/OpenSRF.pm
@@ -42,4 +42,21 @@ Returns the scalar value of its caller.
 
 sub class { return scalar(caller); }
 
+=head2 OSRF_APACHE_REQUEST_OBJ
+
+Gets and sets the Apache request object when running inside mod_perl.
+This allows other parts of OpenSRF to investigate the state of the
+remote connection, such as whether the client has disconnected, and
+react accordingly.
+
+=cut
+
+our $_OARO;
+sub OSRF_APACHE_REQUEST_OBJ {
+	my $self = shift;
+	my $a = shift;
+	$_OARO = $a if $a;
+	return $_OARO;
+}
+
 1;
diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
index d1ebfa1..9e15ecd 100644
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/XMPPReader.pm
@@ -210,7 +210,31 @@ sub wait {
     my $infile = '';
     vec($infile, $socket->fileno, 1) = 1;
 
-    my $nfound = select($infile, undef, undef, $timeout);
+    my $nfound;
+    if (!OpenSRF->OSRF_APACHE_REQUEST_OBJ || $timeout <= 1.0) {
+        $nfound = select($infile, undef, undef, $timeout);
+    } else {
+        $timeout -= 1.0;
+        for (
+            my $sleep = 1.0;
+            $timeout >= 0.0;
+            do {
+                $sleep = $timeout < 1.0 ? $timeout : 1.0;
+                $timeout -= 1.0;
+            }
+        ) {
+            $nfound = select($infile, undef, undef, $sleep);
+            last if $nfound;
+            if (
+                OpenSRF->OSRF_APACHE_REQUEST_OBJ &&
+                OpenSRF->OSRF_APACHE_REQUEST_OBJ->connection->aborted
+            ) {
+                # Should this be more severe? Die or throw error?
+                $logger->warn("Upstream Apache client disconnected, aborting.");
+                last;
+            };
+        }
+    }
     return undef if !$nfound or $nfound == -1;
 
     # now slurp the data off the socket
-- 
2.43.2