patch to add bidirectional i/o to ice-9/popen.scm

[Antoine Mathys]

Hello,

Here is a small patch that brings the following to ice-9/popen.scm :
   - bidirectional communication with a subprocess
   - execution of a command without the shell

It doesn't break existing code: open-pipe now simply accepts OPEN_BOTH 
as second argument and in that case returns an input-output soft-port 
that uses two pipes under the hood.
Furthermore open-input-output-pipe and open-pipe2 are provided (see the 
patch).

This is obviously useful, as the following enlightening example 
demonstrates :);

(use-modules (ice-9 popen))
(use-modules (ice-9 rdelim))

(define (bc-add x y)
 (let ((p (open-pipe "bc" OPEN_BOTH)))
   (display
    (string-append (number->string x) "+"
                   (number->string y) "\n")
    p)
   (let ((result (string->number (read-line p))))
     (close-pipe p)
     result)))

--------

Cheers,

Antoine Mathys








--- ../../local/src/guile-1.7.1/ice-9/popen.scm Thu Aug 19 17:23:36 2004
+++ popen.scm   Sat Nov 27 05:25:40 2004
@@ -18,12 +18,22 @@
 ;;;; 
 
 (define-module (ice-9 popen)
-  :export (port/pid-table open-pipe close-pipe open-input-pipe
-          open-output-pipe))
+  :export (port/pid-table open-pipe2 open-pipe close-pipe open-input-pipe
+          open-output-pipe open-input-output-pipe))
 
 ;;    (define-module (guile popen)
 ;;      :use-module (guile posix))
 
+(define (make-rw-port read-port write-port)
+  (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
 ;; an open pipe is gc'd or a close-port is used.
 (define pipe-guardian (make-guardian))
@@ -35,30 +45,37 @@
   (or (false-if-exception (fileno port))
       (open-fdes *null-device* mode)))
 
-;; run a process connected to an input or output port.
-;; mode: OPEN_READ or OPEN_WRITE.
+;; run a process connected to an input, an output or an
+;; input/output port
+;; mode: OPEN_READ, OPEN_WRITE or OPEN_BOTH
 ;; returns port/pid pair.
 (define (open-process mode prog . args)
-  (let ((p (pipe))
-       (reading (string=? mode OPEN_READ)))
-    (setvbuf (cdr p) _IONBF)
+  (let* ((reading (or (string=? mode OPEN_READ)
+                     (string=? mode OPEN_BOTH)))
+        (writing (or (string=? mode OPEN_WRITE)
+                     (string=? 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)))
       (cond ((= pid 0)
             ;; child
             (set-batch-mode?! #t)
 
             ;; select the three file descriptors to be used as
-            ;; standard descriptors 0, 1, 2 for the new process.  one
-            ;; is the pipe to the parent, the other two are taken
+            ;; standard descriptors 0, 1, 2 for the new
+            ;; process. They are pipes to/from the parent or taken
             ;; from the current Scheme input/output/error ports if
             ;; possible.
 
-            (let ((input-fdes (if reading
+            (let ((input-fdes (if writing
+                                  (fileno (car p2c))
                                   (ensure-fdes (current-input-port)
-                                               O_RDONLY)
-                                  (fileno (car p))))
+                                               O_RDONLY)))
                   (output-fdes (if reading
-                                   (fileno (cdr p))
+                                   (fileno (cdr c2p))
                                    (ensure-fdes (current-output-port)
                                                 O_WRONLY)))
                   (error-fdes (ensure-fdes (current-error-port)
@@ -110,25 +127,35 @@
 
            (else
             ;; parent
-            (if reading
-                (close-port (cdr p))
-                (close-port (car p)))
-            (cons (if reading
-                      (car p)
-                      (cdr p))
+            (if c2p (close-port (cdr c2p)))
+            (if p2c (close-port (car p2c)))
+            (cons (cond ((not writing) (car c2p))
+                        ((not reading) (cdr p2c))
+                        (else (make-rw-port (car c2p)
+                                            (cdr p2c))))
                   pid))))))
 
-(define (open-pipe command mode)
-  "Executes the shell command @var{command} (a string) in a subprocess.
-A pipe to the process is created and returned.  @var{modes} specifies
-whether an input or output pipe to the process is created: it should 
-be the value of @code{OPEN_READ} or @code{OPEN_WRITE}."
-  (let* ((port/pid (open-process mode "/bin/sh" "-c" command))
+(define (open-pipe2 mode command . args)
+  "Executes the program @var{command} with optional arguments
address@hidden (all strings) in a subprocess.
+A port to the process (based on pipes) is created and returned.
address@hidden specifies whether an input, an output or an input-output
+port to the process is created: it should be the value of
address@hidden, @code{OPEN_WRITE} or @code{OPEN_BOTH}."
+  (let* ((port/pid (apply open-process mode command args))
         (port (car port/pid)))
     (pipe-guardian port)
     (hashq-set! port/pid-table port (cdr port/pid))
     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.
address@hidden specifies whether an input, an output or an input-output
+port to the process is created: it should be the value of
address@hidden, @code{OPEN_WRITE} or @code{OPEN_BOTH}."
+  (open-pipe2 mode "/bin/sh" "-c" command))
+
 (define (fetch-pid port)
   (let ((pid (hashq-ref port/pid-table port)))
     (hashq-remove! port/pid-table port)
@@ -185,3 +212,7 @@
 (define (open-output-pipe command)
   "Equivalent to @code{open-pipe} with mode @code{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))
--- ../../local/src/guile-1.7.1/ice-9/ChangeLog Wed Aug 25 11:45:07 2004
+++ ChangeLog   Sat Nov 27 05:29:54 2004
@@ -1,3 +1,12 @@
+2004-11-27  Antoine Mathys <address@hidden>
+
+       * popen.scm: 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-pipe2 to execute programs without using the shell (and
+       actually base open-pipe on it) and the obvious
+       open-input-output-pipe.
+       
 2004-08-25  Kevin Ryde  <address@hidden>
 
        * and-let-star.scm (and-let*): Give #t for an empty body, per srfi-2