diff --git a/NEWS b/NEWS index b4a705231..326617fd8 100644 --- a/NEWS +++ b/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 diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 08d939b9f..a1e6f77f2 100644 --- a/doc/ref/posix.texi +++ b/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}. diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 957cde0aa..df65bcbbc 100644 --- a/module/ice-9/popen.scm +++ b/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)) diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test index 3df863375..b8dfbef13 100644 --- a/test-suite/tests/popen.test +++ b/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 diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 82881aa28..92169792e 100644 --- a/test-suite/tests/ports.test +++ b/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)