From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Rutger van Beusekom Newsgroups: gmane.lisp.guile.devel Subject: guile pipeline patch Date: Wed, 04 Mar 2020 10:50:55 +0100 Message-ID: <87lfog8n40.fsf@verum.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="48636"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.2.0; emacs 26.3 To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Wed Mar 04 15:58:26 2020 Return-path: Envelope-to: guile-devel@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 1j9VTd-000CXt-AG for guile-devel@m.gmane-mx.org; Wed, 04 Mar 2020 15:58:25 +0100 Original-Received: from localhost ([::1]:35298 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j9VTc-0000cY-1R for guile-devel@m.gmane-mx.org; Wed, 04 Mar 2020 09:58:24 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:37466) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1j9QgB-0003zf-Oe for guile-devel@gnu.org; Wed, 04 Mar 2020 04:51:05 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1j9Qg9-0004CS-M0 for guile-devel@gnu.org; Wed, 04 Mar 2020 04:51:03 -0500 Original-Received: from mail-eopbgr00092.outbound.protection.outlook.com ([40.107.0.92]:42958 helo=EUR02-AM5-obe.outbound.protection.outlook.com) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1j9Qg8-00042H-Fy for guile-devel@gnu.org; Wed, 04 Mar 2020 04:51:00 -0500 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=bXH9s56lGBPvuroANSbIFEGKieqsnBA16xSEckryaKE+KEkQB1Q6bQCIcf/MPQ+AP8EJWA9PAWKKWFR4k+SNR+Q6Cn3+kyuRsZ2NQe62dpjvx+sQ+jsbWlU/OyXE+U0xdnFOatOYwkP7onuSCDuwvJVjoT4OAKOCnwO976K7+Bhrm6KVjV8D7gmUE9p6XrAIM7GNozUgc1vefpMO1UHsWWmkM8bbpfzrpD/JduACUTWWKhUj5bdx32NCas2E1+MCRdJorID2DUTVWUyVkl6PGUQAxIVJGpJ3aKz24g7uinRR7EnPcIcMvmBqGE/6kx+Mn/0SsXCf1gzTWtcLPyfyLw== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=Ph9UQAkOoeeobJBVBQkEtquwKXRrzn4lKPGxz+cnu3s=; b=auCvr5VbXAaLf+oBIiDuZQ6x9h954FrFBNkwWEi1eB8SN3eKmH6O6pFmvlgDcHvWeKr+Vnk+cWJn0xrWR0nUyReSZUFxhD85+/2ikomCdAdyJ5Lp/8IIRyLL4Y94zxLMHryykNOh6GgTVrkrXCVzT3cxQ9JAkJzLXLXLD2RVpUHNESPPjuw5Rbdhhqos/VLa5l0M6wEipKgR52+tqq45WoaO9+oM1euhhYUI5+i4hkrnktkshRAARptjhpl/dqRlZkHdthbAy8+c8j02/nIhb5bITMqweKpKidWhJiHUrqbXbMN/lAo6Bn/EBOXHRKZzAy82d6yv2Tmu5XFV4MQmGQ== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=pass smtp.mailfrom=verum.com; dmarc=pass action=none header.from=verum.com; dkim=pass header.d=verum.com; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=verumst.onmicrosoft.com; s=selector2-verumst-onmicrosoft-com; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=Ph9UQAkOoeeobJBVBQkEtquwKXRrzn4lKPGxz+cnu3s=; b=fZjM2lRU8pd3ZMbVb78GUtBRQWiqBdogVlGYv1E2UolW3JyvmI9R2v2Gd8D/P5fmRBkDRHQjy36Gjvze65N1jaKasPG/AVNn1rzoLzTh6nAiCxacCkXjvcT21bVtyZH6JErQ/jX4fI3klh05OY24VtNelipxBoT4zhQ2hhdzAmc= Authentication-Results: spf=none (sender IP is ) smtp.mailfrom=rutger.van.beusekom@verum.com; Original-Received: from AM6PR08MB4455.eurprd08.prod.outlook.com (20.179.7.202) by AM6PR08MB4644.eurprd08.prod.outlook.com (10.255.98.10) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.2772.15; Wed, 4 Mar 2020 09:50:56 +0000 Original-Received: from AM6PR08MB4455.eurprd08.prod.outlook.com ([fe80::558c:a791:d1e5:78ba]) by AM6PR08MB4455.eurprd08.prod.outlook.com ([fe80::558c:a791:d1e5:78ba%7]) with mapi id 15.20.2772.019; Wed, 4 Mar 2020 09:50:56 +0000 X-ClientProxiedBy: AM0PR06CA0012.eurprd06.prod.outlook.com (2603:10a6:208:ab::25) To AM6PR08MB4455.eurprd08.prod.outlook.com (2603:10a6:20b:70::10) X-MS-Exchange-MessageSentRepresentingType: 1 Original-Received: from eigen (213.127.117.17) by AM0PR06CA0012.eurprd06.prod.outlook.com (2603:10a6:208:ab::25) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.2772.14 via Frontend Transport; Wed, 4 Mar 2020 09:50:56 +0000 X-Originating-IP: [213.127.117.17] X-MS-PublicTrafficType: Email X-MS-Office365-Filtering-Correlation-Id: aab6570d-8e18-48f9-1e00-08d7c021890a X-MS-TrafficTypeDiagnostic: AM6PR08MB4644: X-Microsoft-Antispam-PRVS: X-MS-Oob-TLC-OOBClassifiers: OLM:8273; X-Forefront-PRVS: 0332AACBC3 X-Forefront-Antispam-Report: SFV:NSPM; SFS:(10019020)(136003)(376002)(39830400003)(346002)(396003)(366004)(199004)(189003)(16526019)(66556008)(186003)(2906002)(8936002)(66946007)(508600001)(36756003)(86362001)(66616009)(3480700007)(66476007)(7116003)(26005)(52116002)(81156014)(81166006)(8676002)(53546011)(6496006)(6916009)(2616005)(956004)(6486002)(316002)(5660300002)(133083001); DIR:OUT; SFP:1102; SCL:1; SRVR:AM6PR08MB4644; H:AM6PR08MB4455.eurprd08.prod.outlook.com; FPR:; SPF:None; LANG:en; PTR:InfoNoRecords; A:1; MX:1; Received-SPF: None (protection.outlook.com: verum.com does not designate permitted sender hosts) X-MS-Exchange-SenderADCheck: 1 X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: C4YDDQNZ1LzU7haAZyIzx+xHWsI13s7yped73RUxaRqMS9nyWTmNxIoIuys6xzjSmvG1En8aLnEVfOHj/vnlEymRMarK+i0oUOotoqbIjdU4kbwNB8picNMDRfmsAMWg/2+kEwLXI8TbLcIzpYTu2nbkPUtHRJZX636R/HCVPUXjDrQScJfg/ofw/GXVQq164GZUrn7FXQMpfg85G9LdOldF2RB4cHg5KSm2HIfu96bU4xpIWxh8OTC4A/0cZKrX8Gv6eGQvf7HUDhUSk+GrwGiTGirz3ML5CTXt2dyXTtReMmhNdaA3l4WdygQy04uRZ8NiinykjT4TDPfg6AMD6BATWz1Vss4I7yksqvfNbJD0TVAOXCFG0TUJCsdnNYf9JYpb3YLIGU83Agql8+wBz1cupYN/w8SbQ5KKsUkba/QuaZHZyXiBJGx48Da71vHo41nxP0Fe6vdt/qWEYHoyOp9Gf3jgLsdslbmJraQimwWwOXy5TS0wu6B6Khzxgok6 X-MS-Exchange-AntiSpam-MessageData: yvjDmrV5xwJVZ/4OK93NZMvJwIP1GBn3J4bMC0YqXBJlc6oolcyP0rebiZp1mLqKbdzqkboDwaqoc3IM+2/4KV5hNLOZYJRJ5ac2TDslcogxyiyNazIjEXYxOrAIGphFmvnFcCnl3BMDshe3uMPi4A== X-OriginatorOrg: verum.com X-MS-Exchange-CrossTenant-Network-Message-Id: aab6570d-8e18-48f9-1e00-08d7c021890a X-MS-Exchange-CrossTenant-OriginalArrivalTime: 04 Mar 2020 09:50:56.4318 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: a12adc2b-ece0-4282-b9ce-ad23864dd7c5 X-MS-Exchange-CrossTenant-MailboxType: HOSTED X-MS-Exchange-CrossTenant-UserPrincipalName: zEhlrzGzb0swM1fYOtnkLgElQV9hoaeXtTY0MS+OnW6kLnWfkZlK/nuFG295R/o2hJOaTCdLE0NzXPawYanS9tI+el298LbQwBNRFAVDqaU= X-MS-Exchange-Transport-CrossTenantHeadersStamped: AM6PR08MB4644 X-detected-operating-system: by eggs.gnu.org: Windows 7 or 8 [fuzzy] X-Received-From: 40.107.0.92 X-Mailman-Approved-At: Wed, 04 Mar 2020 09:57:35 -0500 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.io gmane.lisp.guile.devel:20428 Archived-At: --=-=-= Content-Type: text/plain Hi, This patch replaces open-process with piped-process in posix.c and reimplement open-process with piped-process in popen.scm. This allows setting up a pipeline in guile scheme using the new pipeline procedure in popen.scm and enables its use on operating systems which happen to lack the capability to fork, but do offer the capability captured by start_child (see posix.c). The snippet below demonstrates the backwards compatibility of this patch as well as the feature it offers: (use-modules (ice-9 popen)) (use-modules (ice-9 rdelim)) (use-modules (ice-9 receive)) (receive (from to pid) ((@@ (ice-9 popen) open-process) OPEN_BOTH "rev") (display "dlrow olleh" to) (close to) (display (read-string from)) (newline) (display (status:exit-val (cdr (waitpid pid)))) (newline)) (receive (from to pids) (pipeline '(("echo" "dlrow olleh") ("rev"))) (display (read-string from)) (display (map waitpid pids)) (newline)) (let ((p (pipe))) (piped-process "echo" '("foo" "bar") (cons (port->fdes (car p)) (port->fdes (cdr p)))) (display (read-string (car p)))) --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Allow-client-code-to-create-pipe-pairs-when-opening-.patch Content-Description: PATCH >From 6cf03c09da190f0e797768b598f9e347168e3f19 Mon Sep 17 00:00:00 2001 From: Rutger van Beusekom Date: Mon, 2 Mar 2020 10:38:57 +0100 Subject: [PATCH] Allow client code to create pipe pairs when opening a process. * libguile/posix.c (scm_piped_process): Replace open_process by piped_process. * module/ice-9/popen.scm (pipe->fdes): Convert pipe pair to fdes pair. (open-process): Implement open-process with piped-process. (pipeline): Implement a pipeline with piped-process. --- libguile/posix.c | 84 +++++++++++++++++++----------------------- module/ice-9/popen.scm | 32 +++++++++++++++- 2 files changed, 68 insertions(+), 48 deletions(-) diff --git a/libguile/posix.c b/libguile/posix.c index a1520abc4..f9ffd5d8e 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1368,55 +1368,56 @@ start_child (const char *exec_file, char **exec_argv, #ifdef HAVE_START_CHILD static SCM -scm_open_process (SCM mode, SCM prog, SCM args) -#define FUNC_NAME "open-process" +scm_piped_process (SCM prog, SCM args, SCM from, SCM to) +#define FUNC_NAME "piped-process" +/* SCM_DEFINE (scm_piped_process, "piped-process", 2, 2, 0, */ +/* (SCM prog, SCM args, SCM from, SCM to), */ +/* "Execute the command indicated by @var{prog} with arguments @var(args),\n" */ +/* "optionally connected by an input and an output pipe.\n" */ +/* "@var(from) and @var(to) are either #f or a valid file descriptor\n" */ +/* "of an input and an output pipe, respectively.\n" */ +/* "\n" */ +/* "This function returns the PID of the process executing @var(prog)." */ +/* "\n" */ +/* "Example:\n" */ +/* "(let ((p (pipe)))\n" */ +/* " (piped-process \"echo\" '(\"foo\" \"bar\")\n" */ +/* " (cons (port->fdes (car p))\n" */ +/* " (port->fdes (cdr p))))\n" */ +/* " (display (read-string (car p))))\n" */ +/* "(let ((p (pipe)))\n" */ +/* " (read-string (piped-process \"echo\" '(\"foo\" \"bar\")\n" */ +/* " (port->fdes (car p)))))\n") */ +/* #define FUNC_NAME scm_piped_process */ { - long mode_bits; int reading, writing; - int c2p[2]; /* Child to parent. */ - int p2c[2]; /* Parent to child. */ + int c2p[2] = {}; /* Child to parent. */ + int p2c[2] = {}; /* Parent to child. */ int in = -1, out = -1, err = -1; int pid; char *exec_file; char **exec_argv; - SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F; exec_file = scm_to_locale_string (prog); exec_argv = scm_i_allocate_string_pointers (scm_cons (prog, args)); - mode_bits = scm_i_mode_bits (mode); - reading = mode_bits & SCM_RDNG; - writing = mode_bits & SCM_WRTNG; + reading = !scm_is_eq (from, SCM_UNDEFINED); + writing = !scm_is_eq (to, SCM_UNDEFINED); if (reading) { - if (pipe (c2p)) - { - int errno_save = errno; - free (exec_file); - errno = errno_save; - SCM_SYSERROR; - } + c2p[0] = scm_to_int (scm_car (from)); + c2p[1] = scm_to_int (scm_cdr (from)); out = c2p[1]; } - + if (writing) { - if (pipe (p2c)) - { - int errno_save = errno; - free (exec_file); - if (reading) - { - close (c2p[0]); - close (c2p[1]); - } - errno = errno_save; - SCM_SYSERROR; - } + p2c[0] = scm_to_int (scm_car (to)); + p2c[1] = scm_to_int (scm_cdr (to)); in = p2c[0]; } - + { SCM port; @@ -1449,23 +1450,12 @@ scm_open_process (SCM mode, SCM prog, SCM args) SCM_SYSERROR; } - /* There is no sense in catching errors on close(). */ if (reading) - { - close (c2p[1]); - read_port = scm_i_fdes_to_port (c2p[0], scm_mode_bits ("r0"), - sym_read_pipe, - SCM_FPORT_OPTION_NOT_SEEKABLE); - } + close (c2p[1]); if (writing) - { - close (p2c[0]); - write_port = scm_i_fdes_to_port (p2c[1], scm_mode_bits ("w0"), - sym_write_pipe, - SCM_FPORT_OPTION_NOT_SEEKABLE); - } + close (p2c[0]); - return scm_values_3 (read_port, write_port, scm_from_int (pid)); + return scm_from_int (pid); } #undef FUNC_NAME @@ -1529,8 +1519,8 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, SCM_UNDEFINED); #endif - res = scm_open_process (scm_nullstr, prog, args); - pid = scm_to_int (scm_c_value_ref (res, 2)); + res = scm_piped_process (prog, args, SCM_BOOL_F, SCM_BOOL_F); + pid = scm_to_int (scm_c_value_ref (res, 0)); SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); if (wait_result == -1) SCM_SYSERROR; @@ -2371,7 +2361,7 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, static void scm_init_popen (void) { - scm_c_define_gsubr ("open-process", 2, 0, 1, scm_open_process); + scm_c_define_gsubr ("piped-process", 2, 2, 0, scm_piped_process); } #endif /* HAVE_START_CHILD */ diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 2afe45701..ad1f64c7c 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -22,9 +22,10 @@ #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (ice-9 threads) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe - open-output-pipe open-input-output-pipe)) + open-output-pipe open-input-output-pipe pipe->fdes piped-process pipeline)) (eval-when (expand load eval) (load-extension (string-append "libguile-" (effective-version)) @@ -84,6 +85,17 @@ (define port/pid-table (make-weak-key-hash-table)) (define port/pid-table-mutex (make-mutex)) +(define (pipe->fdes) + (let ((p (pipe))) + (cons (port->fdes (car p)) + (port->fdes (cdr p))))) + +(define (open-process mode command . args) + (let* ((from (and (or (equal? mode OPEN_READ) (equal? mode OPEN_BOTH)) (pipe->fdes))) + (to (and (or (equal? mode OPEN_WRITE) (equal? mode OPEN_BOTH)) (pipe->fdes))) + (pid (piped-process command args from to))) + (values (and from (fdes->inport (car from))) (and to (fdes->outport (cdr to))) pid))) + (define (open-pipe* mode command . args) "Executes the program @var{command} with optional arguments @var{args} (all strings) in a subprocess. @@ -176,3 +188,21 @@ information on how to interpret this value." "Equivalent to @code{open-pipe} with mode @code{OPEN_BOTH}" (open-pipe command OPEN_BOTH)) + +(define (pipeline procs) + "Execute a pipeline of @code(procs) -- where a proc is a list of a +command and its arguments as strings -- returning an input port to the +end of the pipeline, an output port to the beginning of the pipeline and +a list of PIDs of the @code(procs)" + (let* ((to (pipe->fdes)) + (pipes (map (lambda _ (pipe->fdes)) procs)) + (pipeline (fold (lambda (from proc prev) + (let* ((to (car prev)) + (pids (cdr prev))) + (cons from (cons (piped-process (car proc) (cdr proc) from to) pids)))) + `(,to) + pipes + procs)) + (from (car pipeline)) + (pids (cdr pipeline))) + (values (fdes->inport (car from)) (fdes->outport (cdr to)) pids))) -- 2.25.1 --=-=-=--