[Opensrf-commits] r2195 - branches/rel_2_0/src/perl/lib/OpenSRF (erickson)

[svn at svn.open-ils.org]

Author: erickson
Date: 2011-03-02 10:04:22 -0500 (Wed, 02 Mar 2011)
New Revision: 2195

Modified:
   branches/rel_2_0/src/perl/lib/OpenSRF/Server.pm
Log:
consistent w/ sigpipe handling in osrf 1.6, provide a warning and retry mechanism for syswrites that fail as a result of sigpipe

Modified: branches/rel_2_0/src/perl/lib/OpenSRF/Server.pm
===================================================================
--- branches/rel_2_0/src/perl/lib/OpenSRF/Server.pm	2011-03-02 15:04:00 UTC (rev 2194)
+++ branches/rel_2_0/src/perl/lib/OpenSRF/Server.pm	2011-03-02 15:04:22 UTC (rev 2195)
@@ -25,6 +25,7 @@
 use Encode;
 use POSIX qw/:sys_wait_h :errno_h/;
 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
+use Time::HiRes qw/usleep/;
 use IO::Select;
 use Socket;
 our $chatty = 1; # disable for production
@@ -42,6 +43,7 @@
     $self->{active_list}    = []; # list of active children
     $self->{idle_list}      = []; # list of idle children
     $self->{pid_map}        = {}; # map of child pid to child for cleaner access
+    $self->{sig_pipe}       = 0;  # true if last syswrite failed
 
     $self->{stderr_log} = $self->{stderr_log_path} . "/${service}_stderr.log" 
         if $self->{stderr_log_path};
@@ -236,8 +238,22 @@
 # ----------------------------------------------------------------
 sub write_child {
     my($self, $child, $msg) = @_;
-    my $xml = decode_utf8($msg->to_xml);
-    syswrite($child->{pipe_to_child}, encode_utf8($xml));
+    my $xml = encode_utf8(decode_utf8($msg->to_xml));
+
+    for (0..2) {
+
+        $self->{sig_pipe} = 0;
+        local $SIG{'PIPE'} = sub { $self->{sig_pipe} = 1; };
+
+        # send message to child data pipe
+        syswrite($child->{pipe_to_child}, $xml);
+
+        last unless $self->{sig_pipe};
+        $logger->error("server: got SIGPIPE writing to $child, retrying...");
+        usleep(50000); # 50 msec
+    }
+
+    $logger->error("server: unable to send request message to child $child") if $self->{sig_pipe};
 }
 
 # ----------------------------------------------------------------
@@ -474,7 +490,7 @@
 use OpenSRF::Utils::Logger qw($logger);
 use OpenSRF::DomainObject::oilsResponse qw/:status/;
 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
-use Time::HiRes qw(time);
+use Time::HiRes qw(time usleep);
 use POSIX qw/:sys_wait_h :errno_h/;
 
 use overload '""' => sub { return '[' . shift()->{pid} . ']'; };
@@ -485,6 +501,7 @@
     $self->{pid} = 0; # my process ID
     $self->{parent} = $parent; # Controller parent process
     $self->{num_requests} = 0; # total serviced requests
+    $self->{sig_pipe} = 0;  # true if last syswrite failed
     return $self;
 }
 
@@ -630,10 +647,23 @@
 # ----------------------------------------------------------------
 sub send_status {
     my $self = shift;
-    syswrite(
-        $self->{pipe_to_parent},
-        sprintf("%*s", OpenSRF::Server::STATUS_PIPE_DATA_SIZE, $self->{pid})
-    );
+
+    for (0..2) {
+
+        $self->{sig_pipe} = 0;
+        local $SIG{'PIPE'} = sub { $self->{sig_pipe} = 1; };
+
+        syswrite(
+            $self->{pipe_to_parent},
+            sprintf("%*s", OpenSRF::Server::STATUS_PIPE_DATA_SIZE, $self->{pid})
+        );
+
+        last unless $self->{sig_pipe};
+        $logger->error("server: $self got SIGPIPE writing status to parent, retrying...");
+        usleep(50000); # 50 msec
+    }
+
+    $logger->error("server: $self unable to send status to parent") if $self->{sig_pipe};
 }