mike121 pushed a commit to branch wip-mingw-2025
in repository guile.
commit 1174e1eb9d440112edfecefcdbb8e2c8a992030d
Author: Michael Gran <spk...@yahoo.com>
AuthorDate: Sun Jun 25 07:57:18 2023 -0700
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 | 10 ++++++++++
doc/ref/posix.texi | 23 ++++++++++++++++++++++-
module/ice-9/popen.scm | 25 ++++++++++++++++++-------
test-suite/tests/popen.test | 26 +++++++++++++++++++++++++-
test-suite/tests/ports.test | 8 ++++++++
5 files changed, 83 insertions(+), 9 deletions(-)
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)
