[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/04: Add 'spawn'.
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] 01/04: Add 'spawn'. |
|
Date: |
Fri, 13 Jan 2023 10:15:47 -0500 (EST) |
civodul pushed a commit to branch main
in repository guile.
commit 551929e4fb77341fa5309c138b2ab92966987966
Author: Josselin Poiret <dev@jpoiret.xyz>
AuthorDate: Sat Jan 7 17:07:46 2023 +0100
Add 'spawn'.
* libguile/posix.c: Include spawn.h from Gnulib.
(do_spawn, scm_spawn_process): New functions.
(kw_environment, hw_input, kw_output, kw_error, kw_search_path): New
variables.
* doc/ref/posix.texi (Processes): Document it.
* test-suite/tests/posix.test ("spawn"): New test prefix.
* NEWS: Update.
Co-authored-by: Ludovic Courtès <ludo@gnu.org>
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
NEWS | 15 ++++-
doc/ref/posix.texi | 60 +++++++++++++++--
libguile/posix.c | 156 +++++++++++++++++++++++++++++++++++++++++++-
libguile/posix.h | 3 +-
test-suite/tests/posix.test | 79 +++++++++++++++++++++-
5 files changed, 303 insertions(+), 10 deletions(-)
diff --git a/NEWS b/NEWS
index 07011c3c6..b3d31cf89 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,5 @@
Guile NEWS --- history of user-visible changes.
-Copyright (C) 1996-2022 Free Software Foundation, Inc.
+Copyright (C) 1996-2023 Free Software Foundation, Inc.
See the end for copying conditions.
Please send Guile bug reports to bug-guile@gnu.org.
@@ -11,6 +11,19 @@ Changes in 3.0.9 (since 3.0.8)
* New interfaces and functionality
+** New `spawn' procedure to spawn child processes
+
+The new `spawn' procedure creates a child processes executing the given
+program. It lets you control the environment variables of that process
+and redirect its standard input, standard output, and standard error
+streams.
+
+Being implemented in terms of `posix_spawn', it is more portable, more
+robust, and more efficient than the combination of `primitive-fork' and
+`execl'. See "Processes" in the manual for details, and see the 2019
+paper entitled "A fork() in the road" (Andrew Baumann et al.) for
+background information.
+
** `open-file' now supports an "e" flag for O_CLOEXEC
Until now, the high-level `open-file' facility did not provide a way to
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index bde0f150c..5653d3758 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2045,15 +2045,67 @@ safe to call after a multithreaded fork, which is a
very limited set.
Guile issues a warning if it detects a fork from a multi-threaded
program.
-If you are going to @code{exec} soon after forking, the procedures in
-@code{(ice-9 popen)} may be useful to you, as they fork and exec within
-an async-signal-safe function carefully written to ensure robust program
-behavior, even in the presence of threads. @xref{Pipes}, for more.
+@quotation Note
+If you are looking to spawn a process with some pipes set up, using the
+@code{spawn} procedure described below will be more robust (in
+particular in multi-threaded contexts), more portable, and usually more
+efficient than the combination of @code{primitive-fork} and
+@code{execl}.
+
+@c Recommended reading: ``A fork() in the road'', HotOS 2019,
+@c <https://dx.doi.org/10.1145/3317550.3321435> (paywalled :-/).
+@end quotation
This procedure has been renamed from @code{fork} to avoid a naming conflict
with the scsh fork.
@end deffn
+@deffn {Scheme Procedure} spawn @var{program} @var{arguments} @
+ [#:environment=(environ)] @
+ [#:input=(current-input-port)] @
+ [#:output=(current-output-port)] @
+ [#:error=(current-error-port)] @
+ [#:search-path?=#t]
+Spawn a new child process executing @var{program} with the
+given @var{arguments}, a list of one or more strings (by
+convention, the first argument is typically @var{program}),
+and return its PID. Raise a @code{system-error} exception if
+@var{program} could not be found or could not be executed.
+
+If the keyword argument @code{#:search-path?} is true, it
+selects whether the @env{PATH} environment variable should be
+inspected to find @var{program}. It is true by default.
+
+The @code{#:environment} keyword parameter specifies the
+list of environment variables of the child process. It
+defaults to @code{(environ)}.
+
+The keyword arguments @code{#:input}, @code{#:output}, and
+@code{#:error} specify the port or file descriptor for the
+child process to use as standard input, standard output, and
+standard error. No other file descriptors are inherited
+from the parent process.
+@end deffn
+
+The example below shows how to spawn the @command{uname} program with
+the @option{-o} option (@pxref{uname invocation,,, coreutils, GNU
+Coreutils}), redirect its standard output to a pipe, and read from it:
+
+@lisp
+(use-modules (rnrs io ports))
+
+(let* ((input+output (pipe))
+ (pid (spawn "uname" '("uname" "-o")
+ #:output (cdr input+output))))
+ (close-port (cdr input+output))
+ (format #t "read ~s~%" (get-string-all (car input+output)))
+ (close-port (car input+output))
+ (waitpid pid))
+
+@print{} read "GNU/Linux\n"
+@result{} (1234 . 0)
+@end lisp
+
@deffn {Scheme Procedure} nice incr
@deffnx {C Function} scm_nice (incr)
@cindex process priority
diff --git a/libguile/posix.c b/libguile/posix.c
index b5352c2c4..0e6a38f33 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2014, 2016-2019, 2021-2022
+/* Copyright 1995-2014, 2016-2019, 2021-2023
Free Software Foundation, Inc.
Copyright 2021 Maxime Devos <maximedevos@telenet.be>
@@ -33,6 +33,7 @@
#include <sys/types.h>
#include <uniconv.h>
#include <unistd.h>
+#include <spawn.h>
#ifdef HAVE_SCHED_H
# include <sched.h>
@@ -63,6 +64,7 @@
#include "fports.h"
#include "gettext.h"
#include "gsubr.h"
+#include "keywords.h"
#include "list.h"
#include "modules.h"
#include "numbers.h"
@@ -1426,6 +1428,156 @@ start_child (const char *exec_file, char **exec_argv,
}
#endif
+static pid_t
+do_spawn (char *exec_file, char **exec_argv, char **exec_env,
+ int in, int out, int err, int spawnp)
+{
+ pid_t pid = -1;
+
+ posix_spawn_file_actions_t actions;
+ posix_spawnattr_t *attrp = NULL;
+
+ int max_fd = 1024;
+
+#if defined (HAVE_GETRLIMIT) && defined (RLIMIT_NOFILE)
+ {
+ struct rlimit lim = { 0, 0 };
+ if (getrlimit (RLIMIT_NOFILE, &lim) == 0)
+ max_fd = lim.rlim_cur;
+ }
+#endif
+
+ posix_spawn_file_actions_init (&actions);
+
+ int free_fd_slots = 0;
+ int fd_slot[3];
+
+ for (int fdnum = 3;free_fd_slots < 3 && fdnum < max_fd;fdnum++)
+ {
+ if (fdnum != in && fdnum != out && fdnum != err)
+ {
+ fd_slot[free_fd_slots] = fdnum;
+ free_fd_slots++;
+ }
+ }
+
+ /* Move the fds out of the way, so that duplicate fds or fds equal
+ to 0, 1, 2 don't trample each other */
+
+ posix_spawn_file_actions_adddup2 (&actions, in, fd_slot[0]);
+ posix_spawn_file_actions_adddup2 (&actions, out, fd_slot[1]);
+ posix_spawn_file_actions_adddup2 (&actions, err, fd_slot[2]);
+ posix_spawn_file_actions_adddup2 (&actions, fd_slot[0], 0);
+ posix_spawn_file_actions_adddup2 (&actions, fd_slot[1], 1);
+ posix_spawn_file_actions_adddup2 (&actions, fd_slot[2], 2);
+
+ while (--max_fd > 2)
+ posix_spawn_file_actions_addclose (&actions, max_fd);
+
+ int res = -1;
+ if (spawnp)
+ res = posix_spawnp (&pid, exec_file, &actions, attrp,
+ exec_argv, exec_env);
+ else
+ res = posix_spawn (&pid, exec_file, &actions, attrp,
+ exec_argv, exec_env);
+ if (res != 0)
+ return -1;
+
+ return pid;
+}
+
+SCM_KEYWORD (kw_environment, "environment");
+SCM_KEYWORD (kw_input, "input");
+SCM_KEYWORD (kw_output, "output");
+SCM_KEYWORD (kw_error, "error");
+SCM_KEYWORD (kw_search_path, "search-path?");
+
+SCM_DEFINE (scm_spawn_process, "spawn", 2, 0, 1,
+ (SCM program, SCM arguments, SCM keyword_args),
+ "Spawn a new child process executing @var{program} with the\n"
+ "given @var{arguments}, a list of one or more strings (by\n"
+ "convention, the first argument is typically @var{program}),\n"
+ "and return its PID. Raise a @code{system-error} exception if\n"
+ "@var{program} could not be found or could not be executed.\n\n"
+ "If the keyword argument @code{#:search-path?} is true, it\n"
+ "selects whether the @env{PATH} environment variable should be\n"
+ "inspected to find @var{program}. It is true by default.\n\n"
+ "The @code{#:environment} keyword parameter specifies the\n"
+ "list of environment variables of the child process. It\n"
+ "defaults to @code{(environ)}.\n\n"
+ "The keyword arguments @code{#:input}, @code{#:output}, and\n"
+ "@code{#:error} specify the port or file descriptor for the\n"
+ "child process to use as standard input, standard output, and\n"
+ "standard error. No other file descriptors are inherited\n"
+ "from the parent process.\n")
+#define FUNC_NAME s_scm_spawn_process
+{
+ SCM env, in_scm, out_scm, err_scm, use_path;
+ int pid = -1;
+ char *exec_file, **exec_argv, **exec_env;
+ int in, out, err;
+
+ /* In theory 'exec' accepts zero arguments, but programs are typically
+ not prepared for that and POSIX says: "The value in argv[0] should
+ point to a filename string that is associated with the process
+ image being started" (see
+
<https://pubs.opengroup.org/onlinepubs/9699919799/functions/posix_spawn.html>).
*/
+ SCM_VALIDATE_NONEMPTYLIST (1, arguments);
+
+ env = SCM_UNDEFINED;
+ in_scm = SCM_UNDEFINED;
+ out_scm = SCM_UNDEFINED;
+ err_scm = SCM_UNDEFINED;
+ use_path = SCM_BOOL_T;
+
+ scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0,
+ kw_environment, &env,
+ kw_input, &in_scm,
+ kw_output, &out_scm,
+ kw_error, &err_scm,
+ kw_search_path, &use_path,
+ SCM_UNDEFINED);
+
+ scm_dynwind_begin (0);
+
+ exec_file = scm_to_locale_string (program);
+ scm_dynwind_free (exec_file);
+
+ exec_argv = scm_i_allocate_string_pointers (arguments);
+
+ if (SCM_UNBNDP (env))
+ exec_env = environ;
+ else
+ exec_env = scm_i_allocate_string_pointers (env);
+
+ if (SCM_UNBNDP (in_scm))
+ in_scm = scm_current_input_port ();
+ if (SCM_UNBNDP (out_scm))
+ out_scm = scm_current_output_port ();
+ if (SCM_UNBNDP (err_scm))
+ err_scm = scm_current_error_port ();
+
+#define FDES_FROM_PORT_OR_INTEGER(obj) \
+ (scm_is_integer (obj) ? scm_to_int (obj) : SCM_FPORT_FDES (obj))
+
+ in = FDES_FROM_PORT_OR_INTEGER (in_scm);
+ out = FDES_FROM_PORT_OR_INTEGER (out_scm);
+ err = FDES_FROM_PORT_OR_INTEGER (err_scm);
+
+#undef FDES_FROM_PORT_OR_INTEGER
+
+ pid = do_spawn (exec_file, exec_argv, exec_env,
+ in, out, err, scm_to_bool (use_path));
+ if (pid == -1)
+ SCM_SYSERROR;
+
+ scm_dynwind_end ();
+
+ return scm_from_int (pid);
+}
+#undef FUNC_NAME
+
#ifdef HAVE_START_CHILD
static SCM
scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
@@ -2547,5 +2699,5 @@ scm_init_posix ()
"scm_init_popen",
(scm_t_extension_init_func) scm_init_popen,
NULL);
-#endif /* HAVE_START_CHILD */
+#endif /* HAVE_FORK */
}
diff --git a/libguile/posix.h b/libguile/posix.h
index 6504eaea8..a4b0297b3 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -1,7 +1,7 @@
#ifndef SCM_POSIX_H
#define SCM_POSIX_H
-/* Copyright 1995-1998,2000-2001,2003,2006,2008-2011,2018,2021,2022
+/* Copyright 1995-1998, 2000-2001, 2003, 2006, 2008-2011, 2018, 2021-2023
Free Software Foundation, Inc.
This file is part of Guile.
@@ -69,6 +69,7 @@ SCM_API SCM scm_tmpnam (void);
SCM_API SCM scm_tmpfile (void);
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
SCM_API SCM scm_close_pipe (SCM port);
+SCM_INTERNAL SCM scm_spawn_process (SCM prog, SCM arguments, SCM keyword_args);
SCM_API SCM scm_system_star (SCM cmds);
SCM_API SCM scm_utime (SCM object, SCM actime, SCM modtime,
SCM actimens, SCM modtimens, SCM flags);
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index bfc6f168e..ad13a0a07 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -1,6 +1,6 @@
;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
;;;;
-;;;; Copyright 2003-2004, 2006-2007, 2010, 2012, 2015, 2017-2019, 2021-2022
+;;;; Copyright 2003-2004, 2006-2007, 2010, 2012, 2015, 2017-2019, 2021-2023
;;;; Free Software Foundation, Inc.
;;;; Copyright 2021 Maxime Devos <maximedevos@telenet.be>
;;;;
@@ -19,7 +19,8 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
(define-module (test-suite test-posix)
- :use-module (test-suite lib))
+ #:use-module (test-suite lib)
+ #:use-module ((rnrs io ports) #:select (get-string-all)))
;; FIXME: The following exec tests are disabled since on an i386 debian with
@@ -359,6 +360,80 @@
(parameterize ((current-output-port (current-error-port)))
(status:exit-val (system* "something-that-does-not-exist")))))
+;;
+;; spawn
+;;
+
+(with-test-prefix "spawn"
+
+ (pass-if-equal "basic"
+ 0
+ (cdr (waitpid (spawn "true" '("true")))))
+
+ (pass-if-equal "uname with stdout redirect"
+ (list 0 ;exit value
+ (string-append (utsname:sysname (uname)) " "
+ (utsname:machine (uname)) "\n"))
+ (let* ((input+output (pipe))
+ (pid (spawn "uname" '("uname" "-s" "-m")
+ #:output (cdr input+output))))
+ (close-port (cdr input+output))
+ (let ((str (get-string-all (car input+output))))
+ (close-port (car input+output))
+ (list (cdr (waitpid pid)) str))))
+
+ (pass-if-equal "wc with stdin and stdout redirects"
+ "2\n"
+ (let* ((a+b (pipe))
+ (c+d (pipe))
+ (pid (spawn "wc" '("wc" "-w")
+ #:input (car a+b)
+ #:output (cdr c+d))))
+ (close-port (car a+b))
+ (close-port (cdr c+d))
+
+ (display "Hello world.\n" (cdr a+b))
+ (close-port (cdr a+b))
+
+ (let ((str (get-string-all (car c+d))))
+ (close-port (car c+d))
+ (waitpid pid)
+ str)))
+
+ (pass-if-equal "env with #:environment and #:output"
+ "GNU=guile\n"
+ (let* ((input+output (pipe))
+ (pid (spawn "env" '("env")
+ #:environment '("GNU=guile")
+ #:output (cdr input+output))))
+ (close-port (cdr input+output))
+ (let ((str (get-string-all (car input+output))))
+ (close-port (car input+output))
+ (waitpid pid)
+ str)))
+
+ (pass-if-equal "ls /proc/self/fd"
+ "0\n1\n2\n3\n" ;fourth FD is for /proc/self/fd
+ (if (file-exists? "/proc/self/fd") ;Linux
+ (let* ((input+output (pipe))
+ (pid (spawn "ls" '("ls" "/proc/self/fd")
+ #:output (cdr input+output))))
+ (close-port (cdr input+output))
+ (let ((str (get-string-all (car input+output))))
+ (close-port (car input+output))
+ (waitpid pid)
+ str))
+ (throw 'unresolved)))
+
+ (pass-if-equal "file not found"
+ ENOENT
+ (catch 'system-error
+ (lambda ()
+ (spawn "this-does-not-exist" '("nope")
+ #:search-path? #f))
+ (lambda args
+ (system-error-errno args)))))
+
;;
;; crypt
;;