* libguile/posix.c: Include spawn.h from Gnulib. (do_spawn, scm_spawn_process): New functions. * module/ice-9/spawn.scm: New file (spawn): New procedure. --- libguile/posix.c | 82 ++++++++++++++++++++++++++++++++++++++++++ libguile/posix.h | 2 ++ module/ice-9/spawn.scm | 54 ++++++++++++++++++++++++++++ 3 files changed, 138 insertions(+) create mode 100644 module/ice-9/spawn.scm
diff --git a/libguile/posix.c b/libguile/posix.c index b5352c2c4..52dc11e57 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> @@ -1426,6 +1427,87 @@ 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) +{ + 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); + + if (posix_spawnp (&pid, exec_file, &actions, attrp, exec_argv, exec_env) != 0) + return -1; + + return pid; +} + +SCM_DEFINE (scm_spawn_process, "spawn*", 6, 0, 0, + (SCM prog, SCM args, SCM env, SCM in, SCM out, SCM err), + "Spawns a new child process executing @var{prog} with arguments\n" + "@var{args}, with its standard input, output and error file descriptors\n" + "set to @var{in}, @var{out}, @var{err}, and environment to @var{env}.") +#define FUNC_NAME s_scm_spawn_process +{ + int pid; + char *exec_file; + char **exec_argv; + char **exec_env; + + exec_file = scm_to_locale_string (prog); + exec_argv = scm_i_allocate_string_pointers (args); + exec_env = scm_i_allocate_string_pointers (env); + + pid = do_spawn (exec_file, exec_argv, exec_env, + scm_to_int (in), + scm_to_int (out), + scm_to_int (err)); + + 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) diff --git a/libguile/posix.h b/libguile/posix.h index 6504eaea8..35c502bc1 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -69,6 +69,8 @@ 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 args, SCM env, + SCM in, SCM out, SCM err); 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/module/ice-9/spawn.scm b/module/ice-9/spawn.scm new file mode 100644 index 000000000..ae4f54efa --- /dev/null +++ b/module/ice-9/spawn.scm @@ -0,0 +1,54 @@ +;; Spawning programs + +;;;; Copyright (C) 2022 +;;;; 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 spawn) + #:export (spawn)) + +(define (port-with-defaults port default-mode) + (if (file-port? port) + port + (open-file "/dev/null" default-mode))) + +(define* (spawn exec-file + #:optional (args (list exec-file)) + #:key (env (environ)) + (in (current-input-port)) + (out (current-output-port)) + (err (current-error-port))) + "Spawns a new process running the program @var{exec} with arguments +@var{args}, in the environment specified by the list of environment +variable strings @var{env}, and with standard input, output and error +set to the ports specified by @var{in}, @var{out}, @var{err}. Note that +the last part only works with fd-backed ports." + (let* ((in (port-with-defaults in "r")) + (out (port-with-defaults out "w")) + (err (port-with-defaults err "w")) + ;; Increment port revealed counts while to prevent ports GC'ing and + ;; closing the associated fds while we spawn the process. + (result (spawn* exec-file + args + env + (port->fdes in) + (port->fdes out) + (port->fdes err)))) + (release-port-handle in) + (release-port-handle out) + (release-port-handle err) + result)) base-commit: 4711d45176e9b75cef43699ed514669276af62fe -- 2.38.1