Allows modification of shell used by open-pipe

open-pipe executes a shell command in a subprocess. This commit adds
the ability to modify the shell used for executing commands.
The default "/bin/sh -c" can be inspected and modified by the
new procedure-with-setter 'pipe-shell-command-transformer'.

This useful in MinGW since its "sh" is not in "/bin".

* module/ice-9/popen.scm (%command-transformer): new procedure
  (pipe-shell-command-transformer): new procedure-with-setter
  (open-pipe): use new command transformer
* doc/ref/posix.texi (open-pipe): mention pipe-shell-command-transformer
  (pipe-shell-command-transformer): document new procedure
* test-suite/tests/popen.test ("pipe-shell-command-transformer"): new tests
  Also, modify open-pipe shell for MinGW
* NEWS: updated
* test-suite/tests/ports.test (mingw?): new variable
    Also, modify open-pipe shell for MinGW

NEWS

@@ -82,6 +82,16 @@ of waitpid could no longer emulate ENOHANG.  It relied on Guile keeping
 an internal handle-to-pid table.  It now returns ENOSYS on any non-zero
 waitpid option.
 
+** Add method to change shell used by 'open-pipe'
+
+A procedure-with-setter 'pipe-shell-command-transformer' is added that
+allows the inspection and modification of the shell command used to
+execute commands with open-pipe.  When Guile switched to using
+posix_spawn module, it hardcoded '/bin/sh -c' as the shell used by
+open-pipe.  The new procedure allows modification of that command. This
+is useful on systems that prefer other shells or on systems that don't
+have 'sh' in /bin.
+
 * Performance improvements
 
 ** `copy-file` now relies on `sendfile` rather than a read/write loop

doc/ref/posix.texi

@@ -2481,7 +2481,8 @@ module@footnote{This module is only available on systems where the
 Execute a command in a subprocess, with a pipe to it or from it, or
 with pipes in both directions.
 
-@code{open-pipe} runs the shell @var{command} using @samp{/bin/sh -c}.
+@code{open-pipe} runs the shell @var{command} using the shell.
+By default, it uses @samp{/bin/sh -c}.
 @code{open-pipe*} executes @var{prog} directly, with the optional
 @var{args} arguments (all strings).
 
@@ -2489,6 +2490,9 @@ with pipes in both directions.
 an input pipe, ie.@: to read from the subprocess.  @code{OPEN_WRITE}
 is an output pipe, ie.@: to write to it.
 
+The default shell command that @code{open-pipe} uses can be
+modified with @code{pipe-shell-command-transformer}.
+
 @defvar OPEN_READ
 @defvarx OPEN_WRITE
 @defvarx OPEN_BOTH
@@ -2512,6 +2516,23 @@ buffering (@pxref{Buffering}), which will be enough for small writes,
 but not for say putting a big file through a filter.
 @end deffn
 
+@deffn {Scheme Procedure} pipe-shell-command-transformer
+When executed with no arguments, this returns the procedure that
+@code{open-pipe} uses to convert its command string argument into the
+program arguments to be executed. By default, it is a function that
+takes a string and returns a list that begins with @code{"/bin/sh"
+"-c"}.
+
+This procedure-with-modifier can be @code{set!}.  For example, to change
+the pipe shell from @code{sh} to @code{bash}, one can do the following:
+
+@lisp
+(set! (pipe-shell-command-transformer)
+  (lambda (cmd)
+    (list "/bin/bash" "-c" cmd)))
+@end lisp
+@end deffn
+
 @deffn {Scheme Procedure} open-input-pipe command
 Equivalent to @code{open-pipe} with mode @code{OPEN_READ}.
 

module/ice-9/popen.scm

@@ -1,30 +1,32 @@
 ;; popen emulation, for non-stdio based ports.
 
-;;;; Copyright (C) 1998-2001, 2003, 2006, 2010-2013, 2019
+;;;; Copyright (C) 1998-2001, 2003, 2006, 2010-2013, 2019, 2025
 ;;;;   Free Software Foundation, Inc.
-;;;; 
+;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
 ;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
+;;;;
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;; 
+;;;;
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;;;; 
+;;;;
 
 (define-module (ice-9 popen)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 receive)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
-            open-output-pipe open-input-output-pipe pipeline))
+            open-output-pipe open-input-output-pipe pipeline
+            pipe-shell-command-transformer))
 
 (eval-when (expand load eval)
   (load-extension (string-append "libguile-" (effective-version))
@@ -74,6 +76,15 @@
 
   rw-port)
 
+;; A procedurde that changes the command received by open-pipe into the
+;; shell command to be run by open-pipe*.
+(define (%command-transformer cmd)
+  `("/bin/sh" "-c" ,cmd))
+(define pipe-shell-command-transformer
+  (make-procedure-with-setter
+   (lambda () %command-transformer)
+   (lambda (p) (set! %command-transformer p))))
+
 ;; a guardian to ensure the cleanup is done correctly when
 ;; an open pipe is gc'd or a close-port is used.
 (define pipe-guardian (make-guardian))
@@ -156,7 +167,7 @@ A port to the process (based on pipes) is created and returned.
 @var{mode} specifies whether an input, an output or an input-output
 port to the process is created: it should be the value of
 @code{OPEN_READ}, @code{OPEN_WRITE} or @code{OPEN_BOTH}."
-  (open-pipe* mode "/bin/sh" "-c" command))
+  (apply open-pipe* mode (%command-transformer command)))
 
 (define (fetch-pipe-info port)
   (%port-property port 'popen-pipe-info))

test-suite/tests/popen.test

@@ -1,6 +1,6 @@
 ;;;; popen.test --- exercise ice-9/popen.scm      -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2006, 2010, 2011, 2013, 2014, 2020
+;;;; Copyright 2003, 2006, 2010, 2011, 2013, 2014, 2020, 2025
 ;;;;           2021 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -48,6 +48,30 @@
 (if-supported
  (use-modules (ice-9 popen))
 
+ ;;
+ ;; pipe-shell-command-transformer
+ ;;
+
+ (with-test-prefix "pipe-shell-command-transformer"
+   (pass-if-equal "default shell is /bin/sh"
+       '("/bin/sh" "-c" "test")
+     ((pipe-shell-command-transformer) "test"))
+
+   (pass-if-equal "can set to /bin/bash"
+       '("/bin/bash" "-c" "test")
+     (let ((transform-prev (pipe-shell-command-transformer)))
+       (set! (pipe-shell-command-transformer)
+             (lambda (cmd)
+               `("/bin/bash" "-c" ,cmd)))
+       (let ((cmd ((pipe-shell-command-transformer) "test")))
+         (set! (pipe-shell-command-transformer) transform-prev)
+         cmd))))
+
+ (when mingw?
+   ;; On MinGW, sh is not necessarily in /bin.
+   (set! (pipe-shell-command-transformer)
+         (lambda (cmd)
+           `("sh" "-c" ,cmd))))
 
  ;;
  ;; open-input-pipe

test-suite/tests/ports.test

@@ -31,6 +31,14 @@
                                                get-bytevector-n
                                                get-bytevector-all
                                                unget-bytevector)))
+(define mingw?
+  (string-contains %host-type "-mingw32"))
+
+(when mingw?
+  ;; On MinGW, sh is not necessarily in /bin.
+  (set! (pipe-shell-command-transformer)
+        (lambda (cmd)
+          `("sh" "-c" ,cmd))))
 
 (define (display-line . args)
   (for-each display args)