mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-30 08:50:23 +02:00
Support bidirectional communication by making open-pipe support
OPEN_BOTH as second argument and in that case return a soft input-output port which uses two pipes internally. Provide open-pipe* to execute programs without using the shell (and actually base open-pipe on it) and the obvious open-input-output-pipe.
This commit is contained in:
parent
0c5f718b64
commit
0f3eb62779
1 changed files with 55 additions and 27 deletions
|
@ -18,11 +18,18 @@
|
||||||
;;;;
|
;;;;
|
||||||
|
|
||||||
(define-module (ice-9 popen)
|
(define-module (ice-9 popen)
|
||||||
:export (port/pid-table open-pipe close-pipe open-input-pipe
|
:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
|
||||||
open-output-pipe))
|
open-output-pipe open-input-output-pipe))
|
||||||
|
|
||||||
;; (define-module (guile popen)
|
(define (make-rw-port read-port write-port)
|
||||||
;; :use-module (guile posix))
|
(make-soft-port
|
||||||
|
(vector
|
||||||
|
(lambda (c) (write-char c write-port))
|
||||||
|
(lambda (s) (display s write-port))
|
||||||
|
(lambda () (force-output write-port))
|
||||||
|
(lambda () (read-char read-port))
|
||||||
|
(lambda () (close-port read-port) (close-port write-port)))
|
||||||
|
"r+"))
|
||||||
|
|
||||||
;; a guardian to ensure the cleanup is done correctly when
|
;; a guardian to ensure the cleanup is done correctly when
|
||||||
;; an open pipe is gc'd or a close-port is used.
|
;; an open pipe is gc'd or a close-port is used.
|
||||||
|
@ -35,30 +42,37 @@
|
||||||
(or (false-if-exception (fileno port))
|
(or (false-if-exception (fileno port))
|
||||||
(open-fdes *null-device* mode)))
|
(open-fdes *null-device* mode)))
|
||||||
|
|
||||||
;; run a process connected to an input or output port.
|
;; run a process connected to an input, an output or an
|
||||||
;; mode: OPEN_READ or OPEN_WRITE.
|
;; input/output port
|
||||||
|
;; mode: OPEN_READ, OPEN_WRITE or OPEN_BOTH
|
||||||
;; returns port/pid pair.
|
;; returns port/pid pair.
|
||||||
(define (open-process mode prog . args)
|
(define (open-process mode prog . args)
|
||||||
(let ((p (pipe))
|
(let* ((reading (or (equal? mode OPEN_READ)
|
||||||
(reading (string=? mode OPEN_READ)))
|
(equal? mode OPEN_BOTH)))
|
||||||
(setvbuf (cdr p) _IONBF)
|
(writing (or (equal? mode OPEN_WRITE)
|
||||||
|
(equal? mode OPEN_BOTH)))
|
||||||
|
(c2p (if reading (pipe) #f)) ; child to parent
|
||||||
|
(p2c (if writing (pipe) #f))) ; parent to child
|
||||||
|
|
||||||
|
(if c2p (setvbuf (cdr c2p) _IONBF))
|
||||||
|
(if p2c (setvbuf (cdr p2c) _IONBF))
|
||||||
(let ((pid (primitive-fork)))
|
(let ((pid (primitive-fork)))
|
||||||
(cond ((= pid 0)
|
(cond ((= pid 0)
|
||||||
;; child
|
;; child
|
||||||
(set-batch-mode?! #t)
|
(set-batch-mode?! #t)
|
||||||
|
|
||||||
;; select the three file descriptors to be used as
|
;; select the three file descriptors to be used as
|
||||||
;; standard descriptors 0, 1, 2 for the new process. one
|
;; standard descriptors 0, 1, 2 for the new
|
||||||
;; is the pipe to the parent, the other two are taken
|
;; process. They are pipes to/from the parent or taken
|
||||||
;; from the current Scheme input/output/error ports if
|
;; from the current Scheme input/output/error ports if
|
||||||
;; possible.
|
;; possible.
|
||||||
|
|
||||||
(let ((input-fdes (if reading
|
(let ((input-fdes (if writing
|
||||||
|
(fileno (car p2c))
|
||||||
(ensure-fdes (current-input-port)
|
(ensure-fdes (current-input-port)
|
||||||
O_RDONLY)
|
O_RDONLY)))
|
||||||
(fileno (car p))))
|
|
||||||
(output-fdes (if reading
|
(output-fdes (if reading
|
||||||
(fileno (cdr p))
|
(fileno (cdr c2p))
|
||||||
(ensure-fdes (current-output-port)
|
(ensure-fdes (current-output-port)
|
||||||
O_WRONLY)))
|
O_WRONLY)))
|
||||||
(error-fdes (ensure-fdes (current-error-port)
|
(error-fdes (ensure-fdes (current-error-port)
|
||||||
|
@ -110,25 +124,35 @@
|
||||||
|
|
||||||
(else
|
(else
|
||||||
;; parent
|
;; parent
|
||||||
(if reading
|
(if c2p (close-port (cdr c2p)))
|
||||||
(close-port (cdr p))
|
(if p2c (close-port (car p2c)))
|
||||||
(close-port (car p)))
|
(cons (cond ((not writing) (car c2p))
|
||||||
(cons (if reading
|
((not reading) (cdr p2c))
|
||||||
(car p)
|
(else (make-rw-port (car c2p)
|
||||||
(cdr p))
|
(cdr p2c))))
|
||||||
pid))))))
|
pid))))))
|
||||||
|
|
||||||
(define (open-pipe command mode)
|
(define (open-pipe* mode command . args)
|
||||||
"Executes the shell command @var{command} (a string) in a subprocess.
|
"Executes the program @var{command} with optional arguments
|
||||||
A pipe to the process is created and returned. @var{modes} specifies
|
@var{args} (all strings) in a subprocess.
|
||||||
whether an input or output pipe to the process is created: it should
|
A port to the process (based on pipes) is created and returned.
|
||||||
be the value of @code{OPEN_READ} or @code{OPEN_WRITE}."
|
@var{modes} specifies whether an input, an output or an input-output
|
||||||
(let* ((port/pid (open-process mode "/bin/sh" "-c" command))
|
port to the process is created: it should be the value of
|
||||||
|
@code{OPEN_READ}, @code{OPEN_WRITE} or @code{OPEN_BOTH}."
|
||||||
|
(let* ((port/pid (apply open-process mode command args))
|
||||||
(port (car port/pid)))
|
(port (car port/pid)))
|
||||||
(pipe-guardian port)
|
(pipe-guardian port)
|
||||||
(hashq-set! port/pid-table port (cdr port/pid))
|
(hashq-set! port/pid-table port (cdr port/pid))
|
||||||
port))
|
port))
|
||||||
|
|
||||||
|
(define (open-pipe command mode)
|
||||||
|
"Executes the shell command @var{command} (a string) in a subprocess.
|
||||||
|
A port to the process (based on pipes) is created and returned.
|
||||||
|
@var{modes} 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}."
|
||||||
|
(open-pipe* mode "/bin/sh" "-c" command))
|
||||||
|
|
||||||
(define (fetch-pid port)
|
(define (fetch-pid port)
|
||||||
(let ((pid (hashq-ref port/pid-table port)))
|
(let ((pid (hashq-ref port/pid-table port)))
|
||||||
(hashq-remove! port/pid-table port)
|
(hashq-remove! port/pid-table port)
|
||||||
|
@ -185,3 +209,7 @@ information on how to interpret this value."
|
||||||
(define (open-output-pipe command)
|
(define (open-output-pipe command)
|
||||||
"Equivalent to @code{open-pipe} with mode @code{OPEN_WRITE}"
|
"Equivalent to @code{open-pipe} with mode @code{OPEN_WRITE}"
|
||||||
(open-pipe command OPEN_WRITE))
|
(open-pipe command OPEN_WRITE))
|
||||||
|
|
||||||
|
(define (open-input-output-pipe command)
|
||||||
|
"Equivalent to @code{open-pipe} with mode @code{OPEN_BOTH}"
|
||||||
|
(open-pipe command OPEN_BOTH))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue