* guile pipeline do-over @ 2020-03-06 9:52 Rutger van Beusekom 2020-03-07 15:46 ` Ludovic Courtès 0 siblings, 1 reply; 8+ messages in thread From: Rutger van Beusekom @ 2020-03-06 9:52 UTC (permalink / raw) To: guile-devel [-- Attachment #1: Type: text/plain, Size: 1421 bytes --] 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)))) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: PATCH --] [-- Type: text/x-diff, Size: 9293 bytes --] From 3c8f5d534419418234cfe7d3eda8227951bc208a Mon Sep 17 00:00:00 2001 From: Rutger van Beusekom <rutger.van.beusekom@verum.com> 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 ^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-03-06 9:52 guile pipeline do-over Rutger van Beusekom @ 2020-03-07 15:46 ` Ludovic Courtès 2020-03-10 7:35 ` Rutger van Beusekom 0 siblings, 1 reply; 8+ messages in thread From: Ludovic Courtès @ 2020-03-07 15:46 UTC (permalink / raw) To: Rutger van Beusekom; +Cc: Guile Devel Hi Rutger! Rutger van Beusekom <rutger.van.beusekom@verum.com> skribis: > 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). Nice! That’s definitely very useful to have. We’ll need to check what Andy thinks, but I think it can be added in the 3.0 series. > From 3c8f5d534419418234cfe7d3eda8227951bc208a Mon Sep 17 00:00:00 2001 > From: Rutger van Beusekom <rutger.van.beusekom@verum.com> > 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. Could you mention functions renamed/removed here? The ChangeLog format is about boringly listing all the language-entity-level changes. :-) > * 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. > 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 */ I guess you can remove the commented-out bits… > - int c2p[2]; /* Child to parent. */ > - int p2c[2]; /* Parent to child. */ > + int c2p[2] = {}; /* Child to parent. */ > + int p2c[2] = {}; /* Parent to child. */ … and this hunk, to minimize change. > +++ 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)) I would not export ‘pipe->fdes’. I’m not sure about exporting ‘piped-process’: it’s a bit low-level and we might want to reserve ourselves the possibility to change it, like this patch does actually. WDYT? > +(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))) Please wrap lines to 80 chars. I suggest using ‘string=?’ above instead of ‘equal?’. Also, could you add a docstring? > +(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)" Perhaps s/procs/commands/ would be clearer? Also, @var{commands} instead of @code. Could you also add an entry in doc/ref/*.texi, in the “Pipes” node, perhaps with one of the examples you gave? > +++ 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)) Please move these to the top-level ‘define-module’ form. One last thing: we’d need you to assign copyright to the FSF for this. We can discuss it off-line if you want. Thank you for this great and long overdue addition! Ludo’. ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-03-07 15:46 ` Ludovic Courtès @ 2020-03-10 7:35 ` Rutger van Beusekom 2020-03-10 8:54 ` Linus Björnstam 2020-03-26 9:09 ` Ludovic Courtès 0 siblings, 2 replies; 8+ messages in thread From: Rutger van Beusekom @ 2020-03-10 7:35 UTC (permalink / raw) To: Ludovic Courtès; +Cc: Guile Devel [-- Attachment #1: Type: text/plain, Size: 1732 bytes --] Hi Ludo, I have processed your feedback in this version of the patch. Ludovic Courtès writes: > Hi Rutger! > >> ... > Nice! That’s definitely very useful to have. We’ll need to check what > Andy thinks, but I think it can be added in the 3.0 series. > > >> ... > Could you mention functions renamed/removed here? The ChangeLog format > is about boringly listing all the language-entity-level changes. :-) > Done. > >> ... > I guess you can remove the commented-out bits… > Yep. > >> ... > … and this hunk, to minimize change. > Check. > >> ... > I would not export ‘pipe->fdes’. I’m not sure about exporting > ‘piped-process’: it’s a bit low-level and we might want to reserve > ourselves the possibility to change it, like this patch does actually. > > WDYT? > I agree. >> ... > > Please wrap lines to 80 chars. > Taken care of. > >> ... > > I suggest using ‘string=?’ above instead of ‘equal?’. Also, could you > add a docstring? > Yes and yes. > >> ... > > Perhaps s/procs/commands/ would be clearer? Also, @var{commands} > instead of @code. > Yep. > > Could you also add an entry in doc/ref/*.texi, in the “Pipes” node, > perhaps with one of the examples you gave? > Wrote a new example. WDYT? > >> ... > > Please move these to the top-level ‘define-module’ form. > Done. > > One last thing: we’d need you to assign copyright to the FSF for this. > We can discuss it off-line if you want. > Can you help me there? I already have a verbal commitment from the company, we just need to formalize it. > > Thank you for this great and long overdue addition! > Happy to add it. > > Ludo’. > Rutger [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: PATCH --] [-- Type: text/x-diff, Size: 11004 bytes --] From d351c0a5ecde62e63368bec0e1f15108495a1a71 Mon Sep 17 00:00:00 2001 From: Rutger van Beusekom <rutger.van.beusekom@verum.com> Date: Mon, 2 Mar 2020 10:38:57 +0100 Subject: [PATCH] Add pipeline procedure. * libguile/posix.c (scm_open_process): Remove. (scm_piped_process): Add to replace open_process. * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes pair. (open-process): Add open-process for backwards compatibility. (pipeline): Add to implement a pipeline using piped-process. --- doc/ref/posix.texi | 27 +++++++++++++++ libguile/posix.c | 66 ++++++++++--------------------------- module/ice-9/popen.scm | 46 +++++++++++++++++++++++++- test-suite/tests/popen.test | 37 ++++++++++++++++++++- 4 files changed, 126 insertions(+), 50 deletions(-) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 2c85f803a..d10f6531e 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -2370,6 +2370,33 @@ processes, and a system-wide limit on the number of pipes, so pipes should be closed explicitly when no longer needed, rather than letting the garbage collector pick them up at some later time. +@findex pipeline +@deffn (Scheme Procedure) pipeline commands +Execute a @code{pipeline} of @var{commands} -- where each command is a +list of a program 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 processes executing the @var{commands}. + +@example +(let ((commands '(("git" "ls-files") + ("tar" "-cf-" "-T-") + ("sha1sum" "-"))) + (pipe-fail? (compose not + zero? + status:exit-val + cdr + waitpid))) + (receive (from to pids) (pipeline commands) + (let* ((sha1 (read-delimited " " from)) + (index (list-index pipe-fail? (reverse pids)))) + (close to) + (close from) + (if (not index) sha1 + (string-append "pipeline failed in command: " + (string-join (list-ref commands index))))))) +@result{} "52f99d234503fca8c84ef94b1005a3a28d8b3bc1" +@end example +@end deffn @node Networking @subsection Networking diff --git a/libguile/posix.c b/libguile/posix.c index a1520abc4..dac4197e9 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1368,10 +1368,9 @@ 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" { - long mode_bits; int reading, writing; int c2p[2]; /* Child to parent. */ int p2c[2]; /* Parent to child. */ @@ -1379,44 +1378,27 @@ scm_open_process (SCM mode, SCM prog, SCM args) 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 +1431,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 +1481,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 +1500,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 +2341,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..5ab93f275 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 pipeline)) (eval-when (expand load eval) (load-extension (string-append "libguile-" (effective-version)) @@ -84,6 +85,28 @@ (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) + "Backwards compatible implementation of the former procedure in +libguile/posix.c (scm_open_process) replaced by +scm_piped_process. Executes the program @var{command} with optional +arguments @var{args} (all strings) in a subprocess. A port to the +process (based on pipes) is created and returned. @var{mode} specifies +whether an input, an output or an input-output port to the process is +created: it should be the value of @code{OPEN_READ}, @code{OPEN_WRITE} +or @code{OPEN_BOTH}." + (let* ((from (and (or (string=? mode OPEN_READ) + (string=? mode OPEN_BOTH)) (pipe->fdes))) + (to (and (or (string=? mode OPEN_WRITE) + (string=? 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 +199,24 @@ information on how to interpret this value." "Equivalent to @code{open-pipe} with mode @code{OPEN_BOTH}" (open-pipe command OPEN_BOTH)) +(define (pipeline commands) + "Execute a pipeline of @var(commands) -- where each command is a list of a +program 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 processes executing the @var(commands)." + (let* ((to (pipe->fdes)) + (pipes (map (lambda _ (pipe->fdes)) commands)) + (pipeline (fold (lambda (from proc prev) + (let* ((to (car prev)) + (pids (cdr prev)) + (pid (piped-process (car proc) + (cdr proc) + from + to))) + (cons from (cons pid pids)))) + `(,to) + pipes + commands)) + (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..c780de9a7 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -17,7 +17,10 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-ice-9-popen) - #:use-module (test-suite lib)) + #:use-module (test-suite lib) + #:use-module (ice-9 receive) + #:use-module (ice-9 rdelim)) + ;; read from PORT until eof is reached, return what's read as a string (define (read-string-to-eof port) @@ -211,3 +214,35 @@ 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 +;; + +(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 ((@@ (ice-9 popen) 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 (string=? "hello world\n" (read-string from)) + (equal? '(0 0) (map (compose status:exit-val cdr waitpid) pids))))) -- 2.25.1 ^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-03-10 7:35 ` Rutger van Beusekom @ 2020-03-10 8:54 ` Linus Björnstam 2020-03-10 10:37 ` Rutger van Beusekom 2020-03-26 9:09 ` Ludovic Courtès 1 sibling, 1 reply; 8+ messages in thread From: Linus Björnstam @ 2020-03-10 8:54 UTC (permalink / raw) To: Rutger van Beusekom, Ludovic Courtès; +Cc: Guile Devel I have a question about the interface. It uses the shell now, it seems. (I could be wrong). The guile system call has a (system cmd ) which uses the shell and a system* call which takes (system* cmd arg ...) So that it does not rely on the shell. Maybe a similar interface could be useful (and more secure) for the pipeline as well. Thank you for this patch. Linus Björnstam On Tue, 10 Mar 2020, at 08:35, Rutger van Beusekom wrote: > > Hi Ludo, > > I have processed your feedback in this version of the patch. > > Ludovic Courtès writes: > > > Hi Rutger! > > > >> ... > > Nice! That’s definitely very useful to have. We’ll need to check what > > Andy thinks, but I think it can be added in the 3.0 series. > > > > > >> ... > > Could you mention functions renamed/removed here? The ChangeLog format > > is about boringly listing all the language-entity-level changes. :-) > > > Done. > > > >> ... > > I guess you can remove the commented-out bits… > > > Yep. > > > >> ... > > … and this hunk, to minimize change. > > > Check. > > > >> ... > > I would not export ‘pipe->fdes’. I’m not sure about exporting > > ‘piped-process’: it’s a bit low-level and we might want to reserve > > ourselves the possibility to change it, like this patch does actually. > > > > WDYT? > > > I agree. > >> ... > > > > Please wrap lines to 80 chars. > > > Taken care of. > > > >> ... > > > > I suggest using ‘string=?’ above instead of ‘equal?’. Also, could you > > add a docstring? > > > Yes and yes. > > > >> ... > > > > Perhaps s/procs/commands/ would be clearer? Also, @var{commands} > > instead of @code. > > > Yep. > > > > Could you also add an entry in doc/ref/*.texi, in the “Pipes” node, > > perhaps with one of the examples you gave? > > > Wrote a new example. WDYT? > > > >> ... > > > > Please move these to the top-level ‘define-module’ form. > > > Done. > > > > One last thing: we’d need you to assign copyright to the FSF for this. > > We can discuss it off-line if you want. > > > Can you help me there? I already have a verbal commitment from the > company, we just need to formalize it. > > > > Thank you for this great and long overdue addition! > > > Happy to add it. > > > > Ludo’. > > > Rutger > > > Attachments: > * 0001-Add-pipeline-procedure.patch ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-03-10 8:54 ` Linus Björnstam @ 2020-03-10 10:37 ` Rutger van Beusekom 0 siblings, 0 replies; 8+ messages in thread From: Rutger van Beusekom @ 2020-03-10 10:37 UTC (permalink / raw) To: Linus Björnstam Cc: Rutger van Beusekom, Ludovic Courtès, Guile Devel Hi Linus, pipeline is implemented with piped-process, which is implemented with scm_start_child, which does not use the shell. In your pipeline you can use a shell explicitly if you wanted to. I do not think I should follow the asterisk convention in procedure naming for pipeline. What do you think? Rutger Linus Björnstam writes: > I have a question about the interface. It uses the shell now, it seems. (I could be wrong). The guile system call has a (system cmd ) which uses the shell and a system* call which takes (system* cmd arg ...) So that it does not rely on the shell. Maybe a similar interface could be useful (and more secure) for the pipeline as well. > > Thank you for this patch. > Linus Björnstam > > ... ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-03-10 7:35 ` Rutger van Beusekom 2020-03-10 8:54 ` Linus Björnstam @ 2020-03-26 9:09 ` Ludovic Courtès 2020-04-04 8:01 ` Rutger van Beusekom 1 sibling, 1 reply; 8+ messages in thread From: Ludovic Courtès @ 2020-03-26 9:09 UTC (permalink / raw) To: Rutger van Beusekom; +Cc: Andy Wingo, Guile Devel Hi Rutger, (+Cc: Andy.) Rutger van Beusekom <rutger.van.beusekom@verum.com> skribis: > From d351c0a5ecde62e63368bec0e1f15108495a1a71 Mon Sep 17 00:00:00 2001 > From: Rutger van Beusekom <rutger.van.beusekom@verum.com> > Date: Mon, 2 Mar 2020 10:38:57 +0100 > Subject: [PATCH] Add pipeline procedure. > > * libguile/posix.c (scm_open_process): Remove. > (scm_piped_process): Add to replace open_process. > * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes pair. > (open-process): Add open-process for backwards compatibility. > (pipeline): Add to implement a pipeline using piped-process. There are a couple super minor issues that I comment on below, but otherwise LGTM! If Andy agrees, we can apply it once the copyright assignment is on file, so maybe it won’t be in 3.0.2, we’ll see! > +@deffn (Scheme Procedure) pipeline commands ^ ^ Should be braces. > +Execute a @code{pipeline} of @var{commands} -- where each command is a > +list of a program and its arguments as strings -- returning an input s/--/---/ so we get an em dash and not an en dash (I’m a typography nitpicker :-)). > +port to the end of the pipeline, an output port to the beginning of the > +pipeline and a list of PIDs of the processes executing the @var{commands}. > + > +@example > +(let ((commands '(("git" "ls-files") > + ("tar" "-cf-" "-T-") > + ("sha1sum" "-"))) ^ There’s an extra space on these lines > + (pipe-fail? (compose not > + zero? > + status:exit-val > + cdr > + waitpid))) I don’t think we should encourage this style, which could also look obscure to newcomers. I’d just make it a regular lambda. That’s all for me. Thanks again, Rutger! Ludo’. ^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-03-26 9:09 ` Ludovic Courtès @ 2020-04-04 8:01 ` Rutger van Beusekom 2020-05-16 20:38 ` Ludovic Courtès 0 siblings, 1 reply; 8+ messages in thread From: Rutger van Beusekom @ 2020-04-04 8:01 UTC (permalink / raw) To: Ludovic Courtès; +Cc: Rutger van Beusekom, Andy Wingo, Guile Devel [-- Attachment #1: Type: text/plain, Size: 2343 bytes --] Hi Ludo, Ludovic Courtès writes: > Hi Rutger, > > (+Cc: Andy.) > > Rutger van Beusekom <rutger.van.beusekom@verum.com> skribis: > >> From d351c0a5ecde62e63368bec0e1f15108495a1a71 Mon Sep 17 00:00:00 2001 >> From: Rutger van Beusekom <rutger.van.beusekom@verum.com> >> Date: Mon, 2 Mar 2020 10:38:57 +0100 >> Subject: [PATCH] Add pipeline procedure. >> >> * libguile/posix.c (scm_open_process): Remove. >> (scm_piped_process): Add to replace open_process. >> * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes pair. >> (open-process): Add open-process for backwards compatibility. >> (pipeline): Add to implement a pipeline using piped-process. > > There are a couple super minor issues that I comment on below, but > otherwise LGTM! If Andy agrees, we can apply it once the copyright > assignment is on file, so maybe it won’t be in 3.0.2, we’ll see! As yet I have not received a copyright assignment form. > >> +@deffn (Scheme Procedure) pipeline commands > ^ ^ > Should be braces. > >> +Execute a @code{pipeline} of @var{commands} -- where each command is a >> +list of a program and its arguments as strings -- returning an input > > s/--/---/ so we get an em dash and not an en dash (I’m a typography > nitpicker :-)). > >> +port to the end of the pipeline, an output port to the beginning of the >> +pipeline and a list of PIDs of the processes executing the @var{commands}. >> + >> +@example >> +(let ((commands '(("git" "ls-files") >> + ("tar" "-cf-" "-T-") >> + ("sha1sum" "-"))) > ^ > There’s an extra space on these lines > >> + (pipe-fail? (compose not >> + zero? >> + status:exit-val >> + cdr >> + waitpid))) > > I don’t think we should encourage this style, which could also look > obscure to newcomers. I’d just make it a regular lambda. > Personally I really like composing procedures like a pipeline ;-), but I do not want to obscure things. > That’s all for me. > > Thanks again, Rutger! > > Ludo’. Thank you for helping me find where to dot the i's and cross the t's, please see the updated patch. Rutger. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: PATCH --] [-- Type: text/x-diff, Size: 11014 bytes --] From 9fa48fa3917eb1fab61b703de936471c3c24f4f4 Mon Sep 17 00:00:00 2001 From: Rutger van Beusekom <rutger.van.beusekom@verum.com> Date: Mon, 2 Mar 2020 10:38:57 +0100 Subject: [PATCH] Add pipeline procedure. * libguile/posix.c (scm_open_process): Remove. (scm_piped_process): Add to replace open_process. * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes pair. (open-process): Add open-process for backwards compatibility. (pipeline): Add to implement a pipeline using piped-process. --- doc/ref/posix.texi | 28 ++++++++++++++++ libguile/posix.c | 66 ++++++++++--------------------------- module/ice-9/popen.scm | 46 +++++++++++++++++++++++++- test-suite/tests/popen.test | 37 ++++++++++++++++++++- 4 files changed, 127 insertions(+), 50 deletions(-) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 2c85f803a..e5d63c7b3 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -2370,6 +2370,34 @@ processes, and a system-wide limit on the number of pipes, so pipes should be closed explicitly when no longer needed, rather than letting the garbage collector pick them up at some later time. +@findex pipeline +@deffn {Scheme Procedure} pipeline commands +Execute a @code{pipeline} of @var{commands} --- where each command is a +list of a program 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 processes executing the @var{commands}. + +@example +(let ((commands '(("git" "ls-files") + ("tar" "-cf-" "-T-") + ("sha1sum" "-"))) + (pipe-fail? (lambda (pid) + (not + (zero? + (status:exit-val + (cdr + (waitpid pid)))))))) + (receive (from to pids) (pipeline commands) + (let* ((sha1 (read-delimited " " from)) + (index (list-index pipe-fail? (reverse pids)))) + (close to) + (close from) + (if (not index) sha1 + (string-append "pipeline failed in command: " + (string-join (list-ref commands index))))))) +@result{} "52f99d234503fca8c84ef94b1005a3a28d8b3bc1" +@end example +@end deffn @node Networking @subsection Networking diff --git a/libguile/posix.c b/libguile/posix.c index 9b9b47636..b47b01701 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1372,10 +1372,9 @@ 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" { - long mode_bits; int reading, writing; int c2p[2]; /* Child to parent. */ int p2c[2]; /* Parent to child. */ @@ -1383,44 +1382,27 @@ scm_open_process (SCM mode, SCM prog, SCM args) 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; @@ -1453,23 +1435,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 @@ -1514,8 +1485,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 (); @@ -1533,9 +1504,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; @@ -2382,7 +2352,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..5ab93f275 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 pipeline)) (eval-when (expand load eval) (load-extension (string-append "libguile-" (effective-version)) @@ -84,6 +85,28 @@ (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) + "Backwards compatible implementation of the former procedure in +libguile/posix.c (scm_open_process) replaced by +scm_piped_process. Executes the program @var{command} with optional +arguments @var{args} (all strings) in a subprocess. A port to the +process (based on pipes) is created and returned. @var{mode} specifies +whether an input, an output or an input-output port to the process is +created: it should be the value of @code{OPEN_READ}, @code{OPEN_WRITE} +or @code{OPEN_BOTH}." + (let* ((from (and (or (string=? mode OPEN_READ) + (string=? mode OPEN_BOTH)) (pipe->fdes))) + (to (and (or (string=? mode OPEN_WRITE) + (string=? 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 +199,24 @@ information on how to interpret this value." "Equivalent to @code{open-pipe} with mode @code{OPEN_BOTH}" (open-pipe command OPEN_BOTH)) +(define (pipeline commands) + "Execute a pipeline of @var(commands) -- where each command is a list of a +program 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 processes executing the @var(commands)." + (let* ((to (pipe->fdes)) + (pipes (map (lambda _ (pipe->fdes)) commands)) + (pipeline (fold (lambda (from proc prev) + (let* ((to (car prev)) + (pids (cdr prev)) + (pid (piped-process (car proc) + (cdr proc) + from + to))) + (cons from (cons pid pids)))) + `(,to) + pipes + commands)) + (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..c780de9a7 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -17,7 +17,10 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-ice-9-popen) - #:use-module (test-suite lib)) + #:use-module (test-suite lib) + #:use-module (ice-9 receive) + #:use-module (ice-9 rdelim)) + ;; read from PORT until eof is reached, return what's read as a string (define (read-string-to-eof port) @@ -211,3 +214,35 @@ 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 +;; + +(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 ((@@ (ice-9 popen) 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 (string=? "hello world\n" (read-string from)) + (equal? '(0 0) (map (compose status:exit-val cdr waitpid) pids))))) -- 2.25.1 ^ permalink raw reply related [flat|nested] 8+ messages in thread
* Re: guile pipeline do-over 2020-04-04 8:01 ` Rutger van Beusekom @ 2020-05-16 20:38 ` Ludovic Courtès 0 siblings, 0 replies; 8+ messages in thread From: Ludovic Courtès @ 2020-05-16 20:38 UTC (permalink / raw) To: Rutger van Beusekom; +Cc: Andy Wingo, Guile Devel Hi Rutger, It’s been a looong process (apologies!), but I’m happy to say that this patch is now in master! Hopefully your future contributions will be quicker to get in, otherwise there won’t be anyone to blame but the maintainers. ;-) Rutger van Beusekom <rutger.van.beusekom@verum.com> skribis: > From 9fa48fa3917eb1fab61b703de936471c3c24f4f4 Mon Sep 17 00:00:00 2001 > From: Rutger van Beusekom <rutger.van.beusekom@verum.com> > Date: Mon, 2 Mar 2020 10:38:57 +0100 > Subject: [PATCH] Add pipeline procedure. > > * libguile/posix.c (scm_open_process): Remove. > (scm_piped_process): Add to replace open_process. > * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes pair. > (open-process): Add open-process for backwards compatibility. > (pipeline): Add to implement a pipeline using piped-process. I added bits that were missing from the commit log and followed up with cosmetic tweaks to the tests and doc. It’s all good, thank you for sharing this! Ludo’. ^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2020-05-16 20:38 UTC | newest] Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2020-03-06 9:52 guile pipeline do-over Rutger van Beusekom 2020-03-07 15:46 ` Ludovic Courtès 2020-03-10 7:35 ` Rutger van Beusekom 2020-03-10 8:54 ` Linus Björnstam 2020-03-10 10:37 ` Rutger van Beusekom 2020-03-26 9:09 ` Ludovic Courtès 2020-04-04 8:01 ` Rutger van Beusekom 2020-05-16 20:38 ` Ludovic Courtès
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).