From 14cd517e0cb8829b06b5a49f91c762c4a0e52eb5 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 28 Mar 2023 15:35:56 +0200
Subject: gnu: guile: Fix 'posix_spawn' usage for GNU/Hurd.

* gnu/packages/guile.scm (guile-3.0)[arguments]: Add
'patch-posix-spawn-usage' phase.
* gnu/packages/patches/guile-hurd-posix-spawn.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
---
 gnu/local.mk                                      |  1 +
 gnu/packages/guile.scm                            | 10 ++++++
 gnu/packages/patches/guile-hurd-posix-spawn.patch | 44 +++++++++++++++++++++++
 3 files changed, 55 insertions(+)
 create mode 100644 gnu/packages/patches/guile-hurd-posix-spawn.patch

(limited to 'gnu')

diff --git a/gnu/local.mk b/gnu/local.mk
index 3ce250ce86..58437b7a0e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1293,6 +1293,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
   %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch	\
   %D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
+  %D%/packages/patches/guile-hurd-posix-spawn.patch		\
   %D%/packages/patches/guile-present-coding.patch		\
   %D%/packages/patches/guile-rsvg-pkgconfig.patch		\
   %D%/packages/patches/guile-emacs-fix-configure.patch		\
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 8e52448d36..8d25614e3a 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -371,6 +371,16 @@ without requiring the source code to be rewritten.")
                   (("!#")
                    "!#\n(exit 77)\n"))))
 
+            #$@(if (target-hurd?)
+                   #~((add-before 'build 'patch-posix-spawn-usage
+                        (lambda _
+                          ;; TODO: Move patch to 'source' on next rebuild
+                          ;; cycle.
+                          (define patch
+                            #$(local-file
+                               (search-patch "guile-hurd-posix-spawn.patch")))
+                          (invoke "patch" "--force" "-p1" "-i" patch))))
+                   #~())
             #$@(if (target-ppc32?)
                    #~((add-after 'unpack 'adjust-bootstrap-flags
                         (lambda _
diff --git a/gnu/packages/patches/guile-hurd-posix-spawn.patch b/gnu/packages/patches/guile-hurd-posix-spawn.patch
new file mode 100644
index 0000000000..7cf600b4c2
--- /dev/null
+++ b/gnu/packages/patches/guile-hurd-posix-spawn.patch
@@ -0,0 +1,44 @@
+Fix <https://issues.guix.gnu.org/61095>, which affects GNU/Hurd.
+
+diff --git a/libguile/posix.c b/libguile/posix.c
+index 3a8be94e4..f5fdc544c 100644
+--- a/libguile/posix.c
++++ b/libguile/posix.c
+@@ -1326,7 +1326,14 @@ static void
+ close_inherited_fds_slow (posix_spawn_file_actions_t *actions, int max_fd)
+ {
+   while (--max_fd > 2)
+-    posix_spawn_file_actions_addclose (actions, max_fd);
++    {
++      /* Adding invalid file descriptors to an 'addclose' action leads
++         to 'posix_spawn' failures on some operating systems:
++         <https://bugs.gnu.org/61095>.  Hence the extra check.  */
++      int flags = fcntl (max_fd, F_GETFD, NULL);
++      if ((flags >= 0) && ((flags & FD_CLOEXEC) == 0))
++        posix_spawn_file_actions_addclose (actions, max_fd);
++    }
+ }
+ 
+ static void
+
+Fix <https://issues.guix.gnu.org/62501>.
+
+diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
+index f20e04453..d5cf47cda 100644
+--- a/test-suite/tests/posix.test
++++ b/test-suite/tests/posix.test
+@@ -431,7 +431,13 @@
+       (let ((str (get-string-all (car input+output))))
+         (close-port (car input+output))
+         (waitpid pid)
+-        str)))
++
++        ;; On GNU/Hurd, the exec server prepends 'LD_ORIGIN_PATH' for
++        ;; every program: <https://bugs.gnu.org/62501>.  Strip it.
++        (if (and (string=? "GNU" (utsname:sysname (uname)))
++                 (string-prefix? "LD_ORIGIN_PATH=" str))
++            (string-drop str (+ 1 (string-index str #\newline)))
++            str))))
+ 
+   (pass-if-equal "ls /proc/self/fd"
+       "0\n1\n2\n3\n"                     ;fourth FD is for /proc/self/fd
-- 
cgit 1.4.1