From cfb096fbd836b29a2bfb0c31db9730b0c43a8e55 Mon Sep 17 00:00:00 2001
From: Eric Wilde <ewilde@bsmdevelopment.com>
Date: Tue, 13 Nov 2018 00:22:40 +1300
Subject: [PATCH] Remove dependency on Sys::SigAction

---
 bin/mythtv-status | 86 ++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 74 insertions(+), 12 deletions(-)

diff --git a/bin/mythtv-status b/bin/mythtv-status
index f5e3991..846bdb9 100755
--- a/bin/mythtv-status
+++ b/bin/mythtv-status
@@ -22,11 +22,10 @@ use Date::Manip;
 use Date::Manip::Date;
 use Getopt::Long;
 use Text::Wrap;
-use POSIX qw/strftime :sys_wait_h/;
+use POSIX qw/strftime :sys_wait_h :signal_h/;
 
 use MIME::Entity;
 use Pod::Usage;
-use Sys::SigAction qw/timeout_call/;
 use Encode;
 
 # Try and load a config file first, and then allow the command line
@@ -1236,20 +1235,83 @@ sub pipe_from_fork ($) {
   $pid;
 }
 
-# Takes a LWP::UserAgent, and a HTTP::Request, returns a HTTP::Request
-# Based on:
-# http://stackoverflow.com/questions/73308/true-timeout-on-lwpuseragent-request-method
+# Takes a LWP::UserAgent and an HTTP::Request.  Returns the result of the
+# HTTP::Request.  Handles hung servers as well as timeouts.  Based on:
+# http://stackoverflow.com/questions/73308/true-timeout-on-lwpuseragent-\
+#   request-method
 sub ua_request_with_timeout {
   my ($ua, $url) = @_;
+  my ($req_timeout);
 
-  # Get whatever timeout is set for LWP and use that to 
-  #  enforce a maximum timeout per request in case of server
-  #  deadlock. (This has happened.)
-  our $res = undef;
-  if( timeout_call( $ua->timeout(), sub {$res = $ua->get($url);}) ) {
+  # Pick up LWP's request timeout setting.
+  $req_timeout = $ua->timeout();
+
+  # If Sys::SigAction is available, we can use it to get whatever timeout
+  # is set for LWP and use that to enforce a maximum timeout per request
+  # in case of server deadlock.
+  if (eval("{ local \$SIG{__DIE__}; require Sys::SigAction; }")) {
+    our $resp = undef;
+
+    if (Sys::SigAction::timeout_call( $req_timeout,
+        sub {$resp = $ua->get($url);})) {
       return undef;
-  } else {
-      return $res;
+    } else {
+      return $resp;
+    }
+  }
+
+  # Otherwise, we roll a hard six with a SIGALRM for the timeout.
+  else {
+    my $resp = undef;
+    our $req_has_timedout = 0;
+    my ($newaction, $oldaction);
+
+    # Create a new SIGALRM handler to set the timed out flag if the
+    # backend request is not answered before the interval has elapsed.
+    # Note that die ends the request within the eval (below).  It is
+    # caught by eval, allowing the code herein to continue and check
+    # for a timeout.
+    $newaction = POSIX::SigAction->new(
+        sub { $req_has_timedout = 1; die "Backend request timeout"; },
+        POSIX::SigSet->new(SIGALRM) );
+
+    # Replace the current SIGALRM handler with our new one, saving the
+    # old one for restoration, later on.  If this fails, we just issue
+    # the request directly and hope for the best.
+    $oldaction = POSIX::SigAction->new();
+
+    if (!sigaction(SIGALRM, $newaction, $oldaction)) {
+      warn "Error setting SIGALRM handler: ".$!."\n" if $verbose;
+      return $ua->get($url);
+    }
+
+    # Within an eval, set the timer and request a response from the
+    # backend.  If the timer pops, the SIGALRM routine will set a flag
+    # and kill the request.  The eval will catch it and we'll get on
+    # with our lives.
+    eval {
+      alarm($req_timeout);
+      $resp = $ua->get($url);
+      alarm(0);
+    };
+
+    # Cancel the SIGALRM, if the eval failed for any reason.  Reset the
+    # SIGALRM handler back to its original state.
+    alarm(0);
+
+    if (!sigaction(SIGALRM, $oldaction )) {
+      warn "Error resetting SIGALRM handler: ".$!."\n" if $verbose;
+    };
+
+    # If the request has timed out, return a HTTP 408 (timeout) response
+    # or maybe just undef.  Otherwise, return the backend's response.
+    if ($req_has_timedout) {
+      warn "Backend request timed out (".$req_timeout." secs)\n" if $verbose;
+#      return HTTP::Response->new(408);
+      return undef;
+    } else {
+      return $resp;
+    }
   }
 }
 
-- 
2.30.2