From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Josselin Poiret via "Bug reports for GUILE, GNU's Ubiquitous Extension Language" Newsgroups: gmane.lisp.guile.bugs Subject: bug#52835: [PATCH v8 1/2] Add spawn. Date: Sat, 7 Jan 2023 17:07:46 +0100 Message-ID: <54884b48615fa3291c637eda80e02f94c359485f.1673107558.git.dev@jpoiret.xyz> References: <878rie9vmi.fsf@jpoiret.xyz> Reply-To: Josselin Poiret Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="37975"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 52835@debbugs.gnu.org To: Josselin Poiret , Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Sat Jan 07 17:08:37 2023 Return-path: Envelope-to: guile-bugs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pEBkI-0009gi-RA for guile-bugs@m.gmane-mx.org; Sat, 07 Jan 2023 17:08:36 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pEBjn-0005ax-O5; Sat, 07 Jan 2023 11:08:03 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pEBjm-0005ag-TM for bug-guile@gnu.org; Sat, 07 Jan 2023 11:08:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pEBjm-0000TL-Kz for bug-guile@gnu.org; Sat, 07 Jan 2023 11:08:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pEBjm-0006dX-G1 for bug-guile@gnu.org; Sat, 07 Jan 2023 11:08:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sat, 07 Jan 2023 16:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 52835 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch Original-Received: via spool by 52835-submit@debbugs.gnu.org id=B52835.167310767225479 (code B ref 52835); Sat, 07 Jan 2023 16:08:02 +0000 Original-Received: (at 52835) by debbugs.gnu.org; 7 Jan 2023 16:07:52 +0000 Original-Received: from localhost ([127.0.0.1]:58776 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pEBjc-0006co-4C for submit@debbugs.gnu.org; Sat, 07 Jan 2023 11:07:52 -0500 Original-Received: from jpoiret.xyz ([206.189.101.64]:50634) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pEBja-0006cf-JI for 52835@debbugs.gnu.org; Sat, 07 Jan 2023 11:07:51 -0500 Original-Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id D69B6185306; Sat, 7 Jan 2023 16:07:49 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1673107670; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=MJBXjWOie8APlGrUlT23ZZYz//PP/iwyxTK97zWoMN0=; b=rwsgpDNHqb5EYq+VUUGGvgyyruODzVmp5xFwLBScpqUAtILGPeSudBvJawIPIjPQ/smow0 OgGzOBFnG07cu01xyUOkZOEGvvKTUrRoirgNt9hRog/UyrWP+sblSgLb52yOa5GTlqzoez CspjobQJ0pdwC4DJCV2DhXMGXbO9rWoKpHJXF77Vg4BfN0u2MVbpM0K+hP1buoYqP1oFYc gcRdkU7UmtFzDmkmmuI+5baYSfBRhQofyvOhIToc1ybD/Vq2bLM9b4APalxu2iFCAF7EA7 byzJ8OfzHvNtur8NWo9sza3IWsya4qOAl2xBvAoJPfpLmdyTAGdQxv0FPdqp8g== In-Reply-To: <878rie9vmi.fsf@jpoiret.xyz> Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz X-Spamd-Bar: / X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.bugs:10503 Archived-At: * 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 #include #include +#include #ifdef HAVE_SCHED_H # include @@ -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