[Guile-commits] 04/06: squash! Add 'spawn'.

[Ludovic Courtès]

civodul pushed a commit to branch wip-posix-spawn
in repository guile.

commit cf194dd186a53b5a443f48963ca52f7a712e94a2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jan 12 22:10:10 2023 +0100

    squash! Add 'spawn'.
    
    Changes:
    
      - make 'arguments' positional rather than keyword
      - rename keyword arguments to avoid abbreviations
      - add example in the manual
      - mark 'scm_spawn_process' as SCM_INTERNAL
---
 doc/ref/posix.texi |  65 ++++++++++++++++++----------
 libguile/posix.c   | 121 ++++++++++++++++++++++++-----------------------------
 libguile/posix.h   |   4 +-
 3 files changed, 99 insertions(+), 91 deletions(-)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 36e1f5040..cb737204f 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2047,39 +2047,60 @@ program.
 
 @quotation Note
 If you are only looking to fork+exec with some pipes set up, using pipes
-or the more primitive @code{spawn} will be more robust (e.g. in the
-presence of threads), and is more portable.  @xref{Pipes} for more.
+or the more @code{spawn} procedure described below will be more robust
+(in particular in multi-threaded contexts), more portable, and usually
+more efficient.
 @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 program [#:args=(list program)] @
-       [#:env=(environ)] [#:in=(fileno (current-input-port))] @
-       [#:out=(fileno (current-output-port))] @
-       [#:err=(fileno (current-error-port))] @
-       [#:use-path?=#t]
+@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, and
+return its PID.  Raise a @code{system-error} exception if
+@var{program} could not be found or could not be executed.
 
-Spawns a new child process executing @var{program} with argument list
-@var{args} (which must include the name of the executable as a first
-element), with its environment variables set to @var{env} and standard
-input/output/error file descriptors to @var{in}, @var{out}, @var{err},
-after closing all other file descriptors.  When @var{use-path?} is
-false, @var{program} should be a path to an executable file, but when
-@var{use-path?} is true, the environment variable @code{PATH} is
-searched to find the corresponding executable.
+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.
 
-Failure to exec in the child may be caught early and reported as an
-exception, or the child may also exit with return code 127, depending on
-how spawn is implemented for the specific system.  You therefore must be
-able to handle both cases.
+The @code{#:environment} keyword parameter specifies the
+list of environment variables of the child process.  It
+defaults to @code{(environ)}.
 
-The return value is the pid of the spawned child process.
-
-This procedure is portable and should be thread-safe.
+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 2c6c3c84a..38f938404 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>
 
@@ -1376,24 +1376,37 @@ do_spawn (char *exec_file, char **exec_argv, char 
**exec_env,
   return pid;
 }
 
-SCM k_args, k_env, k_in, k_out, k_err, k_use_path;
-
-SCM_DEFINE (scm_spawn_process, "spawn", 1, 0, 1,
-            (SCM program, SCM keyword_args),
-            "Spawns a new child process executing @var{program} with no 
arguments.\n\n"
-            "If the boolean keyword argument @code{#:use-path?} is provided, 
it\n"
-            "selects whether the @code{PATH} environment variable should be\n"
+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, and\n"
+            "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"
-            "If the keyword arguments @code{#:args}, @code{#:env}, are 
provided,\n"
-            "they respectively modify the arguments or the environment of 
the\n"
-            "spawning program.\n\n"
-            "If the keyword arguments @code{#:in}, @code{#:out} or 
@code{#:err}\n"
-            "are provided, they respectively modify the default input, 
output\n"
-            "and error file descriptor of the spawning program to these 
values.")
+            "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 args, env, in_scm, out_scm, err_scm, use_path;
-  args = SCM_UNDEFINED;
+  SCM env, in_scm, out_scm, err_scm, use_path;
+  int pid = -1;
+  char *exec_file, **exec_argv, **exec_env;
+  int in, out, err;
+
+
   env = SCM_UNDEFINED;
   in_scm = SCM_UNDEFINED;
   out_scm = SCM_UNDEFINED;
@@ -1401,41 +1414,21 @@ SCM_DEFINE (scm_spawn_process, "spawn", 1, 0, 1,
   use_path = SCM_BOOL_T;
 
   scm_c_bind_keyword_arguments (FUNC_NAME, keyword_args, 0,
-                                k_args, &args,
-                                k_env, &env,
-                                k_in, &in_scm,
-                                k_out, &out_scm,
-                                k_err, &err_scm,
-                                k_use_path, &use_path,
+                                kw_environment, &env,
+                                kw_input, &in_scm,
+                                kw_output, &out_scm,
+                                kw_error, &err_scm,
+                                kw_search_path, &use_path,
                                 SCM_UNDEFINED);
 
-  int pid = -1;
-  char *exec_file;
-  char **exec_argv;
-  char **exec_env;
-  int in, out, err;
-
   exec_file = scm_to_locale_string (program);
 
-  if (SCM_UNBNDP (args))
-    {
-      /* We use scm_gc_malloc here because that's the same as what
-         scm_i_allocate_string_pointers would do. */
-      exec_argv = scm_gc_malloc (2 * sizeof (char *),
-                                 "string pointers");
-      exec_argv[0] = exec_file;
-      exec_argv[1] = NULL;
-    }
-  else
-    {
-      exec_argv = scm_i_allocate_string_pointers (args);
-      if (exec_argv[0] == NULL)
-        {
-          free (exec_file);
-          scm_misc_error (FUNC_NAME, "Argument list must not be empty.",
-                          SCM_EOL);
-        }
-    }
+  scm_dynwind_begin (0);
+  scm_dynwind_free (exec_file);
+
+  exec_argv = scm_i_allocate_string_pointers (arguments);
+  if (exec_argv[0] == NULL)
+    SCM_MISC_ERROR ("empty argument list", SCM_EOL);
 
   if (SCM_UNBNDP (env))
     exec_env = environ;
@@ -1443,28 +1436,28 @@ SCM_DEFINE (scm_spawn_process, "spawn", 1, 0, 1,
     exec_env = scm_i_allocate_string_pointers (env);
 
   if (SCM_UNBNDP (in_scm))
-    in = SCM_FPORT_FDES (scm_current_input_port ());
-  else
-    in = scm_to_int (in_scm);
-
+    in_scm = scm_current_input_port ();
   if (SCM_UNBNDP (out_scm))
-    out = SCM_FPORT_FDES (scm_current_output_port ());
-  else
-    out = scm_to_int (out_scm);
-
+    out_scm = scm_current_output_port ();
   if (SCM_UNBNDP (err_scm))
-    err = SCM_FPORT_FDES (scm_current_error_port ());
-  else
-    err = scm_to_int (err_scm);
+    err_scm = scm_current_error_port ();
 
-  pid = do_spawn (exec_file, exec_argv, exec_env,
-                  in, out, err, scm_to_bool (use_path));
+#define FDES_FROM_PORT_OR_INTEGER(obj)                                  \
+  (scm_is_integer (obj) ? scm_to_int (obj) : SCM_FPORT_FDES (obj))
 
-  free (exec_file);
+  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
@@ -2625,10 +2618,4 @@ scm_init_posix ()
                            (scm_t_extension_init_func) scm_init_popen,
                            NULL);
 #endif /* HAVE_FORK */
-  k_args     = scm_from_utf8_keyword ("args");
-  k_env      = scm_from_utf8_keyword ("env");
-  k_in       = scm_from_utf8_keyword ("in");
-  k_out      = scm_from_utf8_keyword ("out");
-  k_err      = scm_from_utf8_keyword ("err");
-  k_use_path = scm_from_utf8_keyword ("use-path?");
 }
diff --git a/libguile/posix.h b/libguile/posix.h
index 5eeafd4cb..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,7 +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_API SCM scm_spawn_process (SCM prog, SCM keyword_args);
+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);