In the rare case sendmsg(2) isn't able to send the full amount
(due to buffers >=2GB on Linux), use print + (autodie)close
to send the remainder and retry on EINTR.  `substr' should be
able to avoid a large malloc via offsets and CoW on modern Perl.
---
 lib/PublicInbox/IPC.pm | 13 +++----------
 t/ipc.t                |  7 +++++++
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/lib/PublicInbox/IPC.pm b/lib/PublicInbox/IPC.pm
index 3292d960..a5cae6f2 100644
--- a/lib/PublicInbox/IPC.pm
+++ b/lib/PublicInbox/IPC.pm
@@ -10,7 +10,7 @@
 package PublicInbox::IPC;
 use v5.12;
 use parent qw(Exporter);
-use autodie qw(fork pipe read socketpair sysread);
+use autodie qw(close fork pipe read socketpair sysread);
 use Carp qw(croak);
 use PublicInbox::DS qw(awaitpid);
 use PublicInbox::Spawn;
@@ -266,15 +266,8 @@ sub stream_in_full ($$$) {
                        0) // croak "sendmsg: $!";
        undef $r;
        $n = $send_cmd->($w, $fds, $buf, 0) // croak "sendmsg: $!";
-       while ($n < length($buf)) {
-               my $x = syswrite($w, $buf, length($buf) - $n, $n);
-               if (!defined($n)) {
-                       next if $!{EINTR};
-                       croak "syswrite: $!";
-               }
-               $x or croak "syswrite wrote 0 bytes";
-               $n += $x;
-       }
+       print $w substr($buf, $n) if $n < length($buf); # need > 2G on Linux
+       close $w; # autodies
 }
 
 sub wq_io_do { # always async
diff --git a/t/ipc.t b/t/ipc.t
index 519ef089..23ae2e7b 100644
--- a/t/ipc.t
+++ b/t/ipc.t
@@ -132,6 +132,13 @@ for my $t ('worker', 'worker again') {
                $exp = sha1_hex($bigger)."\n";
                is(readline($rb), $exp, "SHA WQWorker limit ($t)");
        }
+       SKIP: {
+               $ENV{TEST_EXPENSIVE} or skip 'TEST_EXPENSIVE not set', 1;
+               my $bigger = $big x 75000; # over 2G to trigger partial sendmsg
+               $ipc->wq_io_do('test_sha', [ $wa, $wb ], $bigger);
+               my $exp = sha1_hex($bigger)."\n";
+               is(readline($rb), $exp, "SHA WQWorker sendmsg limit ($t)");
+       }
 }
 
 # wq_io_do works across fork (siblings can feed)

Reply via email to