* libguile/posix.c: Include spawn.h from Gnulib. (do_spawn, scm_spawn_process): New functions. --- doc/ref/posix.texi | 34 ++++++++-- libguile/posix.c | 162 ++++++++++++++++++++++++++++++++++++++++++++- libguile/posix.h | 1 + 3 files changed, 192 insertions(+), 5 deletions(-)
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index bde0f150c..36e1f5040 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -2045,15 +2045,41 @@ 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 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. +@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] + +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. + +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 return value is the pid of the spawned child process. + +This procedure is portable and should be thread-safe. +@end deffn + @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..f79875075 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -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,158 @@ 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 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" + "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.") +#define FUNC_NAME s_scm_spawn_process +{ + SCM args, env, in_scm, out_scm, err_scm, use_path; + args = SCM_UNDEFINED; + 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, + k_args, &args, + k_env, &env, + k_in, &in_scm, + k_out, &out_scm, + k_err, &err_scm, + k_use_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); + } + } + + if (SCM_UNBNDP (env)) + exec_env = environ; + else + 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); + + if (SCM_UNBNDP (out_scm)) + out = SCM_FPORT_FDES (scm_current_output_port ()); + else + out = scm_to_int (out_scm); + + if (SCM_UNBNDP (err_scm)) + err = SCM_FPORT_FDES (scm_current_error_port ()); + else + err = scm_to_int (err_scm); + + pid = do_spawn (exec_file, exec_argv, exec_env, + in, out, err, scm_to_bool (use_path)); + + free (exec_file); + + if (pid == -1) + SCM_SYSERROR; + + 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 +2701,11 @@ scm_init_posix () "scm_init_popen", (scm_t_extension_init_func) scm_init_popen, NULL); -#endif /* HAVE_START_CHILD */ +#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 6504eaea8..5eeafd4cb 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -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_API SCM scm_spawn_process (SCM prog, 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); base-commit: 4711d45176e9b75cef43699ed514669276af62fe -- 2.38.1