commit 08943cae90545dddea44ca55eab68047e5ae2f9d
Author: Andrew Whatson <whatson@gmail.com>
Date:   Mon Nov 21 13:40:33 2022 +1000

    Reduce redundant close() calls when forking on some systems.
    
    Some systems provide "/proc/self/fd" which is a directory containing an
    entry for each open file descriptor in the current process.  We use this
    to limit the number of close() calls needed to ensure file descriptors
    aren't leaked to the child process when forking.
    
    * libguile/posix.c (close_inherited_fds_slow):
    (close_inherited_fds): New static helper functions.
    (start_child): Attempt to close inherited file descriptors efficiently
    using 'close_inherited_fds', falling back to the brute-force approach in
    'close_inherited_fds_slow'.

diff --git a/libguile/posix.c b/libguile/posix.c
index b5352c2c4..fc3512054 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -24,6 +24,7 @@
 #  include <config.h>
 #endif
 
+#include <dirent.h>
 #include <errno.h>
 #include <fcntl.h>
 #include <stdio.h>
@@ -1337,6 +1338,46 @@ renumber_file_descriptor (int fd, int err)
 }
 #endif /* HAVE_FORK */
 
+static void
+close_inherited_fds_slow(int max_fd, int in, int out, int err)
+{
+  while (max_fd--)
+    if (max_fd != in && max_fd != out && max_fd != err)
+      close (max_fd);
+}
+
+static void
+close_inherited_fds(int max_fd, int in, int out, int err)
+{
+  DIR *dirp;
+  struct dirent *d;
+  int fd;
+
+  /* Try to use the platform-specific list of open file descriptors, so
+     we don't need to use the brute force approach. */
+  dirp = opendir ("/proc/self/fd");
+
+  if (dirp == NULL)
+    return close_inherited_fds_slow (max_fd, in, out, err);
+
+  while ((d = readdir (dirp)) != NULL)
+    {
+      fd = atoi (d->d_name);
+
+      /* Skip "." and "..", and any garbage entries. */
+      if (fd <= 0)
+        continue;
+
+      /* Keep in/out/err open. */
+      if (fd == in || fd == out || fd == err)
+        continue;
+
+      close (fd);
+    }
+
+  closedir (dirp);
+}
+
 #ifdef HAVE_FORK
 #define HAVE_START_CHILD 1
 /* Since Guile uses threads, we have to be very careful to avoid calling
@@ -1373,9 +1414,7 @@ start_child (const char *exec_file, char **exec_argv,
 
   /* Close all file descriptors in ports inherited from the parent
      except for in, out, and err.  Heavy-handed, but robust.  */
-  while (max_fd--)
-    if (max_fd != in && max_fd != out && max_fd != err)
-      close (max_fd);
+  close_inherited_fds (max_fd, in, out, err);
 
   /* Ignore errors on these open() calls.  */
   if (in == -1)