From d807bc85bb73ad26154640aeeb2ff5c481e6a143 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 11 Aug 2022 22:03:10 +0100
Subject: [PATCH] prefork-interp: replace fail with fail_log

This was quite confusing.  But, this is called where we may not have a
useful parent stderr.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 perl/Prefork.pm | 45 +++++++++++++++++++++++----------------------
 1 file changed, 23 insertions(+), 22 deletions(-)

diff --git a/perl/Prefork.pm b/perl/Prefork.pm
index afcf50e..3eb9a27 100644
--- a/perl/Prefork.pm
+++ b/perl/Prefork.pm
@@ -16,10 +16,9 @@ our $env_name = 'PREFORK_INTERP';
 our @call_fds;
 our $socket_path;
 
-sub fail ($) {
+sub fail_log ($) {
   my ($m) = @_;
-  print STDERR "$0: prefork [$$]: $m\n";
-  flush STDERR;
+  syslog(LOG_ERROR, "$0: prefork [$$]: error: $m");
   _exit 127;
 }
 
@@ -34,17 +33,17 @@ sub become_monitor () {
   my $child = fork // fail("fork executor: $!");
   if (!$child) {
     #---- executor ----
-    open ::STDIN , "<& $call_fds[0]" or fail("dup for fd0");
-    open ::STDOUT, ">& $call_fds[1]" or fail("dup for fd1");
-    open ::STDERR, ">& $call_fds[2]" or fail("dup for fd2");
+    open ::STDIN , "<& $call_fds[0]" or fail_log("dup for fd0");
+    open ::STDOUT, ">& $call_fds[1]" or fail_log("dup for fd1");
+    open ::STDERR, ">& $call_fds[2]" or fail_log("dup for fd2");
     POSIX::close($_) foreach @call_fds;
     close CALL;
     return;
   }
 
   #---- monitor [2] ----
-  my $got = waitpid $child, 0 // fail("wait for executor: $!");
-  $got == $child or fail("wait for esecutor gave $got, expected $child");
+  my $got = waitpid $child, 0 // fail_log("wait for executor: $!");
+  $got == $child or fail_log("wait for esecutor gave $got, expected $child");
 
   protocol_write(pack "L", $?);
   _exit(0);
@@ -54,7 +53,7 @@ sub protocol_write ($) {
   my ($d) = @_;
   return if (print CALL $d and flush CALL);
   _exit(0) if $!==EPIPE || $!==ECONNRESET;
-  fail("protocol write: $!");
+  fail_log("protocol write: $!");
 }
 
 sub eintr_retry ($) {
@@ -70,7 +69,7 @@ sub eintr_retry ($) {
 sub protocol_read_fail ($) {
   my ($what) = @_;
   _exit(0) if $!==ECONNRESET;
-  fail("recv $what: $!");
+  fail_log("recv $what: $!");
 }
 
 sub protocol_exchange () {
@@ -98,12 +97,12 @@ sub protocol_exchange () {
   $r == $len or _exit(0);
 
   @ARGV = split /\0/, $data;
-  @ARGV >= 2 or fail("message data has too few strings");
-  length(pop(@ARGV)) and fail("message data missing trailing nul");
+  @ARGV >= 2 or fail_log("message data has too few strings");
+  length(pop(@ARGV)) and fail_log("message data missing trailing nul");
   %ENV = ();
   while (my $s = shift @ARGV) {
     last if !length $s;
-    $s =~ m/=/ or fail("message data env var missing equals");
+    $s =~ m/=/ or fail_log("message data env var missing equals");
     $ENV{$`} = $';
   }
 }
@@ -155,18 +154,20 @@ sub initialisation_complete {
   
   # --- server(pm) [2] ----
 
-  setsid() > 0 or fail("setsid: $!");
-  open STDIN, "<&NULL" or fail("dup null onto stdin: $!");
-  open STDOUT, ">&NULL" or fail("dup null onto stdout: $!");
-  open STDERR, ">&NULL" or fail("dup null onto stderr: $!");
+  setsid() > 0 or fail_log("setsid: $!");
+  open STDIN, "<&NULL" or fail_log("dup null onto stdin: $!");
+  open STDOUT, ">&NULL" or fail_log("dup null onto stdout: $!");
+  open STDERR, ">&NULL" or fail_log("dup null onto stderr: $!");
   close NULL;
 
   POSIX::close($_) foreach @call_fds;
   close CALL;
 
-  my $flags = fcntl(LISTEN, F_GETFL, 0) or fail("F_GETFL listen socket: $!");
+  my $flags = fcntl(LISTEN, F_GETFL, 0)
+    or fail_log("F_GETFL listen socket: $!");
   $flags |= O_NONBLOCK;
-  fcntl(LISTEN, F_SETFL, $flags) or fail("F_SETFL listen socket: $!");
+  fcntl(LISTEN, F_SETFL, $flags)
+    or fail_log("F_SETFL listen socket: $!");
 
   my $errcount = 0;
 
@@ -195,7 +196,7 @@ sub initialisation_complete {
 
     if ($nfound) {
       if (accept(CALL, LISTEN)) {
-	$child = fork // fail("fork for accepted call failed: $!");
+	$child = fork // fail_log("fork for accepted call failed: $!");
 	if (!$child) {
 	  #---- monitor [1] ----
 	  close LISTEN;
@@ -218,10 +219,10 @@ sub initialisation_complete {
     }
 
     # are we still live?
-    my @st_listen = stat(LISTEN) // fail("fstat listening socket: $!");
+    my @st_listen = stat(LISTEN) // fail_log("fstat listening socket: $!");
     my @st_socket = stat($socket_path) // do {
       if ($! == ENOENT) { server_quit("socket $socket is ENOENT"); }
-      fail("stat socket $socket: $!");
+      fail_log("stat socket $socket: $!");
     };
     if ("@st_listen[0..2]" ne "@st_socket[0..2]") {
       server_quit("socket $socket is no longer ours");
-- 
2.30.2