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 do-over Date: Fri, 06 Mar 2020 10:52:54 +0100 Message-ID: <8736al24jt.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="49526"; 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 Fri Mar 06 10:53:52 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 1jA9fz-000Coa-Q0 for guile-devel@m.gmane-mx.org; Fri, 06 Mar 2020 10:53:51 +0100 Original-Received: from localhost ([::1]:33666 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jA9fy-00043f-NV for guile-devel@m.gmane-mx.org; Fri, 06 Mar 2020 04:53:50 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:43169) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jA9fB-0003zj-6x for guile-devel@gnu.org; Fri, 06 Mar 2020 04:53:03 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jA9f8-0000XR-QA for guile-devel@gnu.org; Fri, 06 Mar 2020 04:53:00 -0500 Original-Received: from mail-eopbgr70090.outbound.protection.outlook.com ([40.107.7.90]:65479 helo=EUR04-HE1-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 1jA9f8-0000T8-7b for guile-devel@gnu.org; Fri, 06 Mar 2020 04:52:58 -0500 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=kCojlqOuNuxVXkqEgZ2V5AbWxbYj2KIeaAM/U3J82L/pXZPj9vlIKm2xmRuKkKaOBWwLxReZDxBwpM47Ll/bZKgX9PYSA2UYQNfIULuUwGu635LTow/X7Xhz0U5SdARVaPf1llj829eD5lBrwKqhI/cvF6J7DzmxWihqYVwDpMPAM9Bud6THx2FuPcAkxd53onKfaTybyRvGlAWJTLGiICXwjiavCt0aggPX3r/0ZLoCT2NERcPGu7VydfuKkyso9CGt3IKT4/i5xRsWEDQk0/hRvHGcDOb9zGF88T/E8els7ZTCMQk/Cl9I0z+ujgNKGY4lHKsu/HG040z8JqdUKg== 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=agB/f4zJlBimu0i8NzFc1W0//oBBTLzRhIJQ2HemHvc=; b=aM7keHjCYQHK0z57QnainZ1APT/wTe4FCbbYZbxjGe3TykxG5N0BPqnQekkVJ9eiSpRy9xDP7FSDX+Shk32cWYZ8m8kL2ZJogeeeR/rtPSLG+mst1CWmuJAUjj4GspI4kfOcTUoxeZ26a5ZektYh8hu48S2LVD+2nAhWBrW2sg6ccwgf2L2TZ0HdbrnWfLNKONKRCYkerzsEkhXA+jEL+u+uTfQrHJv/iIez7nFZF/6G2msY8jxlEqZzde5VKI8sUzOON5JvYQAPLdq0cfxha+As0J/BRyHgF+UQQweOEiK/OQYyaOZmZN9MtSxAmys1ssf8IIrP6qroDGOd0g2/Gg== 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=agB/f4zJlBimu0i8NzFc1W0//oBBTLzRhIJQ2HemHvc=; b=aBhTmpqUZUCiDk/YYeeJ7eAl8dC0bNWkssWp0ENwoGN6LUyTYkxM202JaR8anH/mEBRzjevQ9GUUSp8Fx2AdN6uvT0mbUmV5GKac9FY6W5tyV2i/c/SHn3c7ZYheWASATYfpk9wNLOKMjTSCs00C/llJ59veb7F580UbEu5Hfuw= 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 AM6PR08MB3670.eurprd08.prod.outlook.com (20.177.115.27) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.2772.14; Fri, 6 Mar 2020 09:52:55 +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; Fri, 6 Mar 2020 09:52:55 +0000 X-ClientProxiedBy: AM0PR01CA0117.eurprd01.prod.exchangelabs.com (2603:10a6:208:168::22) 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 AM0PR01CA0117.eurprd01.prod.exchangelabs.com (2603:10a6:208:168::22) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.2793.11 via Frontend Transport; Fri, 6 Mar 2020 09:52:54 +0000 X-Originating-IP: [213.127.117.17] X-MS-PublicTrafficType: Email X-MS-Office365-Filtering-Correlation-Id: 856434aa-b071-4a87-db35-08d7c1b42499 X-MS-TrafficTypeDiagnostic: AM6PR08MB3670: X-Microsoft-Antispam-PRVS: X-MS-Oob-TLC-OOBClassifiers: OLM:4941; X-Forefront-PRVS: 0334223192 X-Forefront-Antispam-Report: SFV:NSPM; SFS:(10019020)(136003)(376002)(346002)(366004)(396003)(39830400003)(199004)(189003)(6486002)(2906002)(3480700007)(36756003)(316002)(86362001)(5660300002)(508600001)(26005)(186003)(8676002)(16526019)(956004)(66946007)(53546011)(66616009)(81166006)(6916009)(81156014)(66476007)(2616005)(66556008)(52116002)(6496006)(8936002); DIR:OUT; SFP:1102; SCL:1; SRVR:AM6PR08MB3670; 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: MvDn8E1D79gLt+nSu/EGyWQOOaGUgTFc/Rfqw2dlzYeC6KLlcXER9FkiRotqrc2MC8QCwoWJU5YSXsUn0sJ9e2OW/o0rlFu8Yi1l+bwXfXxusFXYP8lsd2gF1NKA5rqhPPvaEehclS3/S4wv4zUFQoRUGu9TbJ6iiFZbh4CS0dSAvMqt1CS4Zot4+hf81tRqi048/8mAdY7Mt6KIyyxN3khIdP4Lt2hf9uxYkMRGVEf3hHDUi7pT3yHKKn1w70W88ZvlKnT7YbjJ1+hbTG01E8SMnFrZ5icsAnN7ggxyzM2iaIXBFOyY7hAZx6yKftV3XtfKIca+qNEc5OuObFQAMda6qM/+hMycG7DAylI4eGZDyeQRRddHU+LRy1aumnkxEcddXLtYpSuY8X011bAqp6mUeZ5WVyQwOCbmd619xrpYpkGvub3rIvaLBEEai5/L X-MS-Exchange-AntiSpam-MessageData: VPt3agZl1VjGmO8GlGPaJwS42MtPBGKp9Zz1tmmCSPdAvRNnMcfzhDu/2uRYPfg8Fzcv2CWzfhG3znq7JHTVqlOdKH5U3O4RIR6X1mNcBKsositGT0K+kw0cZWmoiE9pH4ctiEdDdqnT3A1LWv0nyg== X-OriginatorOrg: verum.com X-MS-Exchange-CrossTenant-Network-Message-Id: 856434aa-b071-4a87-db35-08d7c1b42499 X-MS-Exchange-CrossTenant-OriginalArrivalTime: 06 Mar 2020 09:52:55.1339 (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: GzOJAeG88dusZxhz5M5KsHD6cJ9LbVe2Wr3PfhHXEKnwhJSlu+NN78O3DIpdjhH8AmDxXVkC46/g7Y9b8NavtWyYi+WYRZugFBvWlE4UVi8= X-MS-Exchange-Transport-CrossTenantHeadersStamped: AM6PR08MB3670 X-detected-operating-system: by eggs.gnu.org: Windows 7 or 8 [fuzzy] X-Received-From: 40.107.7.90 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:20431 Archived-At: --=-=-= Content-Type: text/plain Hi, I submitted a previous version of this patch yesterday, only to find that making last minute changes is a big fat no no. Anyhow, having fixed the two problems I found, I also added the tests I should have written and run before sending my patch. Best, Rutger Content of previous email below: 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 3c8f5d534419418234cfe7d3eda8227951bc208a 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 | 89 ++++++++++++++++--------------------- module/ice-9/popen.scm | 32 ++++++++++++- test-suite/tests/popen.test | 34 ++++++++++++++ 3 files changed, 104 insertions(+), 51 deletions(-) diff --git a/libguile/posix.c b/libguile/posix.c index a1520abc4..81f5ebde2 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_pair (from); + writing = scm_is_pair (to); 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 @@ -1510,8 +1500,8 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, "Example: (system* \"echo\" \"foo\" \"bar\")") #define FUNC_NAME s_scm_system_star { - SCM prog, res; - int pid, status, wait_result; + SCM prog, pid; + int status, wait_result; if (scm_is_null (args)) SCM_WRONG_NUM_ARGS (); @@ -1529,9 +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)); - SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); + pid = scm_piped_process (prog, args, SCM_UNDEFINED, SCM_UNDEFINED); + SCM_SYSCALL (wait_result = waitpid (scm_to_int (pid), &status, 0)); if (wait_result == -1) SCM_SYSERROR; @@ -2371,7 +2360,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))) diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test index 2c0877484..94f2d2f20 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -211,3 +211,37 @@ exec 2>~a; read REPLY" (let ((st (close-pipe (open-output-pipe "exit 1")))) (and (status:exit-val st) (= 1 (status:exit-val st))))))) + + +;; +;; pipeline related tests +;; + +(use-modules (ice-9 receive)) +(use-modules (ice-9 rdelim)) + +(pass-if "open-process" + (receive (from to pid) + ((@@ (ice-9 popen) open-process) OPEN_BOTH "rev") + (display "dlrow olleh" to) (close to) + (and (equal? "hello world" (read-string from)) + (= 0 (status:exit-val (cdr (waitpid pid))))))) + +(pass-if "piped-process" + (= 42 (status:exit-val + (cdr (waitpid ((@@ (ice-9 popen) piped-process) "./meta/guile" '("-c" "(exit 42)"))))))) + +(pass-if "piped-process: with output" + (let* ((p (pipe)) + (pid (piped-process "echo" '("foo" "bar") + (cons (port->fdes (car p)) + (port->fdes (cdr p)))))) + + (and (equal? "foo bar\n" (read-string (car p))) + (= 0 (status:exit-val (cdr (waitpid pid))))))) + +(pass-if "pipeline" + (receive (from to pids) + (pipeline '(("echo" "dlrow olleh") ("rev"))) + (and (equal? "hello world\n" (read-string from)) + (equal? '(0 0) (map (compose status:exit-val cdr waitpid) pids))))) -- 2.25.1 --=-=-=--