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 v7 1/2] Add spawn* and spawn. Date: Fri, 23 Dec 2022 18:17:05 +0100 Message-ID: <388cbca36850d1837b3c478d9bd9dd5e222215b0.1671815759.git.dev@jpoiret.xyz> References: <87v8m2jb3c.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="14113"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 52835@debbugs.gnu.org, Josselin Poiret To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-X-From: bug-guile-bounces+guile-bugs=m.gmane-mx.org@gnu.org Fri Dec 23 18:18:31 2022 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 1p8lgh-0003LX-IE for guile-bugs@m.gmane-mx.org; Fri, 23 Dec 2022 18:18:28 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1p8lgK-00081H-6M; Fri, 23 Dec 2022 12:18:04 -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 1p8lgI-0007za-7M for bug-guile@gnu.org; Fri, 23 Dec 2022 12:18: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 1p8lgH-00055Z-Ot for bug-guile@gnu.org; Fri, 23 Dec 2022 12:18:01 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1p8lgH-0007V9-Jo for bug-guile@gnu.org; Fri, 23 Dec 2022 12:18:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Fri, 23 Dec 2022 17:18:01 +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.167181583228810 (code B ref 52835); Fri, 23 Dec 2022 17:18:01 +0000 Original-Received: (at 52835) by debbugs.gnu.org; 23 Dec 2022 17:17:12 +0000 Original-Received: from localhost ([127.0.0.1]:37849 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p8lfT-0007Uc-NA for submit@debbugs.gnu.org; Fri, 23 Dec 2022 12:17:12 -0500 Original-Received: from jpoiret.xyz ([206.189.101.64]:45368) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p8lfR-0007UV-Lx for 52835@debbugs.gnu.org; Fri, 23 Dec 2022 12:17:10 -0500 Original-Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id B34C0184D6B; Fri, 23 Dec 2022 17:17:08 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1671815829; 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=nQyELhx1kZno8MJGBjzGFvn/A6ER4i6BfcTTqqGqvY4=; b=VXWIORlLDXk8bnOnpnf68wB8tLAgAm6AeAQ9JL26EVWuF+ikS9yJ538VlgL4wuDoYgmn50 BzScPLupjdAr9txGeXyonCbqE/uRcBPlhclzAisJLBOaL4gXIRmHsN05xj+QqVI//KcDPa 6BF5futI4+Oy+QAZe2FM7/5Q9klCgNAJEcOccurhvfnQL0p3s+RuGyeJj0O2QjWN+Jz/yU ZWTvOYqmaDAhJnMV1O/hOYPIhrktMQDf16QOSUP/FaG9aUpClF6oIqIKmXNR9lzQ0liq7g WW4HhfLIHEhXfZn6FCrR48K8uQjCZt6VbnHL4PlfUBAiLzN+ApqBUGsFY1wxgA== In-Reply-To: <87v8m2jb3c.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:10489 Archived-At: * 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 #include #include +#include #ifdef HAVE_SCHED_H # include @@ -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