Subject: [PATCH 3/6] gnu: chez-scheme: Fix use of "/bin/sh".

From: Philip McGrath <[email-masked]>
Date: Mon, 8 Aug 2022 02:10:04 -0400

The unsuccessful attempt to execute "/bin/sh" by Chez Scheme's 'process'
function seems to have caused parts of the Chez Scheme test suite to
have been silently skipped. The issue was exposed by the upcoming
changes to Racket's build system.

* gnu/packages/patches/chez-scheme-bin-sh.patch,
gnu/packages/patches/racket-chez-scheme-bin-sh.patch: New patches.
* gnu/packages/patches/racket-minimal-sh-via-rktio.patch: Rename to ...
* gnu/packages/patches/racket-rktio-bin-sh.patch: ... this, refresh with
upstream, and shorten the macro name.
* gnu/local.mk (dist_patch_DATA): Update accordingly.
* gnu/packages/racket.scm (%racket-origin)[patches]: Likewise.
(racket-vm-common-configure-flags): Likewise.
* gnu/packages/chez.scm (chez-scheme)[origin]<patches>: Likewise.
[inputs]: Add bash-minimal.
[arguments]<#:configure-flags>: Set CPPFLAGS to enable new patches.
---
 gnu/local.mk                                  |  4 +-
 gnu/packages/chez.scm                         |  5 ++
 gnu/packages/patches/chez-scheme-bin-sh.patch | 66 +++++++++++++++++++
 .../patches/racket-chez-scheme-bin-sh.patch   | 66 +++++++++++++++++++
 ...-rktio.patch => racket-rktio-bin-sh.patch} | 28 ++++----
 gnu/packages/racket.scm                       |  5 +-
 6 files changed, 158 insertions(+), 16 deletions(-)
 create mode 100644 gnu/packages/patches/chez-scheme-bin-sh.patch
 create mode 100644 gnu/packages/patches/racket-chez-scheme-bin-sh.patch
 rename gnu/packages/patches/{racket-minimal-sh-via-rktio.patch => racket-rktio-bin-sh.patch} (79%)

diff --git a/gnu/local.mk b/gnu/local.mk
index 234f21ad33..e827feed36 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -940,6 +940,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/ceph-boost-compat.patch			\
   %D%/packages/patches/ceph-rocksdb-compat.patch		\
   %D%/packages/patches/cheese-vala-update.patch		        \
+  %D%/packages/patches/chez-scheme-bin-sh.patch			\
   %D%/packages/patches/chmlib-inttypes.patch			\
   %D%/packages/patches/cl-asdf-config-directories.patch		\
   %D%/packages/patches/clamav-config-llvm-libs.patch		\
@@ -1769,7 +1770,8 @@ dist_patch_DATA =						\
   %D%/packages/patches/ripperx-missing-file.patch		\
   %D%/packages/patches/rpcbind-CVE-2017-8779.patch		\
   %D%/packages/patches/rtags-separate-rct.patch			\
-  %D%/packages/patches/racket-minimal-sh-via-rktio.patch	\
+  %D%/packages/patches/racket-chez-scheme-bin-sh.patch		\
+  %D%/packages/patches/racket-rktio-bin-sh.patch		\
   %D%/packages/patches/remake-impure-dirs.patch			\
   %D%/packages/patches/restic-0.9.6-fix-tests-for-go1.15.patch	\
   %D%/packages/patches/retroarch-LIBRETRO_DIRECTORY.patch	\
diff --git a/gnu/packages/chez.scm b/gnu/packages/chez.scm
index 4c253effa0..66098c7a24 100644
--- a/gnu/packages/chez.scm
+++ b/gnu/packages/chez.scm
@@ -34,6 +34,7 @@ (define-module (gnu packages chez)
   #:use-module (guix build-system copy)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system copy)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages ghostscript)
@@ -269,6 +270,7 @@ (define-public chez-scheme
                (base32
                 "0xchqq8cm0ka5wgpn18sjs0hh15rc3nb7xrjqbbc9al3asq0d7gc"))
               (file-name (git-file-name name version))
+              (patches (search-patches "chez-scheme-bin-sh.patch"))
               (snippet #~(begin
                            (use-modules (guix build utils))
                            ;; TODO: consider putting this in a (guix ...) or
@@ -287,6 +289,7 @@ (define-public chez-scheme
       `(,util-linux "lib") ;<-- libuuid
       zlib
       lz4
+      bash-minimal ;<-- for process
       ncurses ;<-- for expeditor
       ;; for X11 clipboard support in expeditor:
       ;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232
@@ -313,6 +316,8 @@ (define-public chez-scheme
                         (cut memq 'threads <>))
                  #~("--threads")
                  #~())
+          ,(string-append "CPPFLAGS=-DGUIX_RKTIO_BIN_SH="
+                          #$(file-append bash-minimal "/bin/sh"))
           "ZLIB=-lz"
           "LZ4=-llz4"
           "--libkernel"
diff --git a/gnu/packages/patches/chez-scheme-bin-sh.patch b/gnu/packages/patches/chez-scheme-bin-sh.patch
new file mode 100644
index 0000000000..e6228e3264
--- /dev/null
+++ b/gnu/packages/patches/chez-scheme-bin-sh.patch
@@ -0,0 +1,66 @@
+From c170f0f3a326f293ee1f460a70303382966ca41b Mon Sep 17 00:00:00 2001
+From: Philip McGrath <[email-masked]>
+Date: Thu, 19 May 2022 13:41:56 -0400
+Subject: [PATCH] patch s_process for "/bin/sh" on Guix
+
+This patch reuses the C preprocessor macro `GUIX_RKTIO_BIN_SH`
+from a previous patch.
+
+If:
+
+    1. The `GUIX_RKTIO_BIN_SH` macro is defined; and
+
+    2. The path specified by `GUIX_RKTIO_BIN_SH` exists;
+
+then `s_process` will call `execl` with the file specified by
+`GUIX_RKTIO_BIN_SH` instead of "/bin/sh".
+
+This patch does not change the behavior of `s_system`, which relies
+on `system` from the C library.
+---
+ c/prim5.c | 20 +++++++++++++++++++-
+ 1 file changed, 19 insertions(+), 1 deletion(-)
+
+diff --git a/c/prim5.c b/c/prim5.c
+index 5a07893..926d68d 100644
+--- a/c/prim5.c
++++ b/c/prim5.c
+@@ -746,6 +746,22 @@ static ptr s_process(char *s, IBOOL stderrp) {
+ 
+     INT tofds[2], fromfds[2], errfds[2];
+     struct sigaction act, oint_act;
++    /* BEGIN PATCH for Guix */
++#if defined(GUIX_RKTIO_BIN_SH)
++# define GUIX_AS_a_STR_HELPER(x) #x
++# define GUIX_AS_a_STR(x) GUIX_AS_a_STR_HELPER(x)
++    /* A level of indirection makes `#` work as needed: */
++    struct stat guix_stat_buf;
++    char *guix_sh =
++      (0 == stat(GUIX_AS_a_STR(GUIX_RKTIO_BIN_SH), &guix_stat_buf))
++      ? GUIX_AS_a_STR(GUIX_RKTIO_BIN_SH)
++      : "/bin/sh";
++# undef GUIX_AS_a_STR
++# undef GUIX_AS_a_STR_HELPER
++#else /* GUIX_RKTIO_BIN_SH */
++    char *guix_sh = "/bin/sh";
++#endif
++    /* END PATCH for Guix */
+ 
+     if (pipe(tofds)) S_error("process","cannot open pipes");
+     if (pipe(fromfds)) {
+@@ -771,7 +787,9 @@ static ptr s_process(char *s, IBOOL stderrp) {
+         CLOSE(1); if (dup(fromfds[1]) != 1) _exit(1);
+         CLOSE(2); if (dup(stderrp ? errfds[1] : 1) != 2) _exit(1);
+         {INT i; for (i = 3; i < NOFILE; i++) (void)CLOSE(i);}
+-        execl("/bin/sh", "/bin/sh", "-c", s, NULL);
++        /* BEGIN PATCH for Guix */
++        execl(guix_sh, guix_sh, "-c", s, NULL);
++        /* END PATCH for Guix */
+         _exit(1) /* only if execl fails */;
+         /*NOTREACHED*/
+     } else {
+
+base-commit: 9df56e7b25bc523663eac3da24be33afc5f76c84
+-- 
+2.32.0
+
diff --git a/gnu/packages/patches/racket-chez-scheme-bin-sh.patch b/gnu/packages/patches/racket-chez-scheme-bin-sh.patch
new file mode 100644
index 0000000000..df2eb671b3
--- /dev/null
+++ b/gnu/packages/patches/racket-chez-scheme-bin-sh.patch
@@ -0,0 +1,66 @@
+From 5f3fc12bf123f30485800960b0493f5dd538d107 Mon Sep 17 00:00:00 2001
+From: Philip McGrath <[email-masked]>
+Date: Thu, 19 May 2022 13:41:56 -0400
+Subject: [PATCH] Chez Scheme: patch s_process for "/bin/sh" on Guix
+
+This patch reuses the C preprocessor macro `GUIX_RKTIO_BIN_SH`
+from a previous patch.
+
+If:
+
+    1. The `GUIX_RKTIO_BIN_SH` macro is defined; and
+
+    2. The path specified by `GUIX_RKTIO_BIN_SH` exists;
+
+then `s_process` will call `execl` with the file specified by
+`GUIX_RKTIO_BIN_SH` instead of "/bin/sh".
+
+This patch does not change the behavior of `s_system`, which relies
+on `system` from the C library.
+---
+ racket/src/ChezScheme/c/prim5.c | 20 +++++++++++++++++++-
+ 1 file changed, 19 insertions(+), 1 deletion(-)
+
+diff --git a/racket/src/ChezScheme/c/prim5.c b/racket/src/ChezScheme/c/prim5.c
+index f5e3e345be..9db2989138 100644
+--- a/racket/src/ChezScheme/c/prim5.c
++++ b/racket/src/ChezScheme/c/prim5.c
+@@ -856,6 +856,22 @@ static ptr s_process(s, stderrp) char *s; IBOOL stderrp; {
+ 
+     INT tofds[2], fromfds[2], errfds[2];
+     struct sigaction act, oint_act;
++    /* BEGIN PATCH for Guix */
++#if defined(GUIX_RKTIO_BIN_SH)
++# define GUIX_AS_a_STR_HELPER(x) #x
++# define GUIX_AS_a_STR(x) GUIX_AS_a_STR_HELPER(x)
++    /* A level of indirection makes `#` work as needed: */
++    struct stat guix_stat_buf;
++    char *guix_sh =
++      (0 == stat(GUIX_AS_a_STR(GUIX_RKTIO_BIN_SH), &guix_stat_buf))
++      ? GUIX_AS_a_STR(GUIX_RKTIO_BIN_SH)
++      : "/bin/sh";
++# undef GUIX_AS_a_STR
++# undef GUIX_AS_a_STR_HELPER
++#else /* GUIX_RKTIO_BIN_SH */
++    char *guix_sh = "/bin/sh";
++#endif
++    /* END PATCH for Guix */
+ 
+     if (pipe(tofds)) S_error("process","cannot open pipes");
+     if (pipe(fromfds)) {
+@@ -881,7 +897,9 @@ static ptr s_process(s, stderrp) char *s; IBOOL stderrp; {
+         CLOSE(1); if (dup(fromfds[1]) != 1) _exit(1);
+         CLOSE(2); if (dup(stderrp ? errfds[1] : 1) != 2) _exit(1);
+         {INT i; for (i = 3; i < NOFILE; i++) (void)CLOSE(i);}
+-        execl("/bin/sh", "/bin/sh", "-c", s, NULL);
++        /* BEGIN PATCH for Guix */
++        execl(guix_sh, guix_sh, "-c", s, NULL);
++        /* END PATCH for Guix */
+         _exit(1) /* only if execl fails */;
+         /*NOTREACHED*/
+     } else {
+
+base-commit: 9d228d16fb99c274c964e5bef93e97333888769f
+-- 
+2.32.0
+
diff --git a/gnu/packages/patches/racket-minimal-sh-via-rktio.patch b/gnu/packages/patches/racket-rktio-bin-sh.patch
similarity index 79%
rename from gnu/packages/patches/racket-minimal-sh-via-rktio.patch
rename to gnu/packages/patches/racket-rktio-bin-sh.patch
index 6bc2ee8331..4f7f2da083 100644
--- a/gnu/packages/patches/racket-minimal-sh-via-rktio.patch
+++ b/gnu/packages/patches/racket-rktio-bin-sh.patch
@@ -1,7 +1,7 @@
-From 3574b567c486d264d680a37586436c3b5a8cb978 Mon Sep 17 00:00:00 2001
+From 070abbcc0d880ca4f97f997e096ac66650ccaaa0 Mon Sep 17 00:00:00 2001
 From: Philip McGrath <[email-masked]>
 Date: Thu, 4 Mar 2021 04:11:50 -0500
-Subject: [PATCH] patch rktio_process for "/bin/sh" on Guix
+Subject: [PATCH] rktio: patch rktio_process for "/bin/sh" on Guix
 
 Racket provides the functions `system` and `process`,
 which execute shell commands using `sh` (or `cmd` on Windows).
@@ -13,17 +13,17 @@ the C function that implements the core of `system`, `process`,
 and related Racket functions.
 
 Guix should enable the special case by defining the C preprocessor
-macro `GUIX_RKTIO_PATCH_BIN_SH` with the path to `sh` in the store.
+macro `GUIX_RKTIO_BIN_SH` with the path to `sh` in the store.
 If:
 
-    1. The `GUIX_RKTIO_PATCH_BIN_SH` macro is defined; and
+    1. The `GUIX_RKTIO_BIN_SH` macro is defined; and
 
     2. `rktio_process` is called with the exact path "/bin/sh"; and
 
-    3. The path specified by `GUIX_RKTIO_PATCH_BIN_SH` does exists;
+    3. The file specified by `GUIX_RKTIO_BIN_SH` exists;
 
 then `rktio_process` will execute the file specified
-by `GUIX_RKTIO_PATCH_BIN_SH` instead of "/bin/sh".
+by `GUIX_RKTIO_BIN_SH` instead of "/bin/sh".
 
 Compared to previous attempts to patch the Racket sources,
 making this change at the C level is both:
@@ -39,10 +39,10 @@ making this change at the C level is both:
  1 file changed, 20 insertions(+), 1 deletion(-)
 
 diff --git a/racket/src/rktio/rktio_process.c b/racket/src/rktio/rktio_process.c
-index 89202436c0..465ebdd5c5 100644
+index fafaf728c1..0a319b381a 100644
 --- a/racket/src/rktio/rktio_process.c
 +++ b/racket/src/rktio/rktio_process.c
-@@ -1224,12 +1224,14 @@ int rktio_process_allowed_flags(rktio_t *rktio)
+@@ -1301,12 +1301,14 @@ int rktio_process_allowed_flags(rktio_t *rktio)
  /*========================================================================*/
  
  rktio_process_result_t *rktio_process(rktio_t *rktio,
@@ -58,19 +58,19 @@ index 89202436c0..465ebdd5c5 100644
    rktio_process_result_t *result;
    intptr_t to_subprocess[2], from_subprocess[2], err_subprocess[2];
    int pid;
-@@ -1255,6 +1257,23 @@ rktio_process_result_t *rktio_process(rktio_t *rktio,
+@@ -1333,6 +1335,23 @@ rktio_process_result_t *rktio_process(rktio_t *rktio,
    int i;
  #endif
  
 +/* BEGIN PATCH for Guix */
-+#if defined(GUIX_RKTIO_PATCH_BIN_SH)
++#if defined(GUIX_RKTIO_BIN_SH)
 +# define GUIX_AS_a_STR_HELPER(x) #x
 +# define GUIX_AS_a_STR(x) GUIX_AS_a_STR_HELPER(x)
 +  /* A level of indirection makes `#` work as needed: */
 +  command =
 +      ((0 == strcmp(_guix_orig_command, "/bin/sh"))
-+       && rktio_file_exists(rktio, GUIX_AS_a_STR(GUIX_RKTIO_PATCH_BIN_SH)))
-+      ? GUIX_AS_a_STR(GUIX_RKTIO_PATCH_BIN_SH)
++       && rktio_file_exists(rktio, GUIX_AS_a_STR(GUIX_RKTIO_BIN_SH)))
++      ? GUIX_AS_a_STR(GUIX_RKTIO_BIN_SH)
 +      : _guix_orig_command;
 +# undef GUIX_AS_a_STR
 +# undef GUIX_AS_a_STR_HELPER
@@ -82,6 +82,8 @@ index 89202436c0..465ebdd5c5 100644
    /* avoid compiler warnings: */
    to_subprocess[0] = -1;
    to_subprocess[1] = -1;
+
+base-commit: 9d228d16fb99c274c964e5bef93e97333888769f
 -- 
-2.21.1 (Apple Git-122.3)
+2.32.0
 
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index 3399bcc3fe..cddb617232 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -212,7 +212,8 @@ (define %racket-origin
     (sha256
      (base32 "0f9zyhdvbh4xsndrqjzl85j5ziz0rmqi676g9s1lw3h3skq2636h"))
     (file-name (git-file-name "racket" %racket-version))
-    (patches (search-patches "racket-minimal-sh-via-rktio.patch"))
+    (patches (search-patches "racket-chez-scheme-bin-sh.patch"
+                             "racket-rktio-bin-sh.patch"))
     (modules '((guix build utils)))
     (snippet
      #~(begin
@@ -248,7 +249,7 @@ (define (racket-vm-common-configure-flags)
                (list (string-append "--enable-racket=" racket))))
          (else
           '()))
-      ,(string-append "CPPFLAGS=-DGUIX_RKTIO_PATCH_BIN_SH="
+      ,(string-append "CPPFLAGS=-DGUIX_RKTIO_BIN_SH="
                       #$(file-append bash-minimal "/bin/sh"))
       "--disable-strip"
       ;; Using --enable-origtree lets us distinguish the VM from subsequent
-- 
2.32.0