bug#15228: [PATCH] Close output port of I/O pipes

[Andy Wingo]

Hi :)

I dunno how much we should push this "processes are a single port"
abstraction.  In many ways for OPEN_BOTH pipes it's easier to deal with
an input and an output port and a PID instead of the pipe abstraction.
WDYT?  We could just expose `open-process' from (ice-9 popen) to start
with.  It would be good to allow other fd's or ports to map to the child
as well, e.g. stderr or any particular port; but I don't know what
interface we should expose.

Thoughts?

Andy

On Sat 31 Aug 2013 10:29, Josep Portella Florit <address@hidden> writes:

> There is a missing feature for pipes created with mode OPEN_BOTH:
>
> (use-modules (ice-9 popen))
> (use-modules (rnrs io ports))
>
> (let ((p (open-pipe "md5sum" OPEN_BOTH)))
>   (put-string p "hello")
>   (let ((x (get-string-all p)))
>     (close-pipe p)
>     x))
>
> This code deadlocks in get-string-all because md5sum, like other
> filters, keeps waiting for input until the pipe's output port is
> closed.
>
> The output port can't be closed without closing the input port too,
> because an I/O pipe is a soft port that doesn't store the 2 ports
> returned by open-process, but a thunk which closes both ports.
>
> This is now possible with the new procedure close-pipe-output:
>
> (let ((p (open-pipe "md5sum" OPEN_BOTH)))
>   (put-string p "hello")
>   (close-pipe-output p)
>   (let ((x (get-string-all p)))
>     (close-pipe p)
>     x))
> ;; => "5d41402abc4b2a76b9719d911017c592  -\n"
>
> The intention is to make a backwards compatible and minimal change
> that makes it possible to write to and read from pipes for filters
> like md5sum without temporary files.
>
> Changes involved:
>
> * module/ice-9/popen.scm: Define a weak hash-table for mapping I/O pipes to
>   their output ports, change make-rw-port to use it, define the
>   close-pipe-output procedure and export it.
>
> * doc/ref/posix.texi: Add documentation for close-pipe-output.
>
> On garbage collection the new hash-table is updated as expected:
>
> scheme@(ice-9 popen)> rw/w-table
> $3 = #<weak-key-hash-table 8b8a930 0/31>
> scheme@(ice-9 popen)> (define p (open-pipe "md5sum" OPEN_BOTH))
> scheme@(ice-9 popen)> rw/w-table
> $4 = #<weak-key-hash-table 8b8a930 1/31>
> scheme@(ice-9 popen)> (set! p #f)
> scheme@(ice-9 popen)> (gc)
> scheme@(ice-9 popen)> rw/w-table
> $5 = #<weak-key-hash-table 8b8a930 0/31>
>
> Maybe there is a better name for the new procedure.
> ---
>  doc/ref/posix.texi     |    6 ++++++
>  module/ice-9/popen.scm |   39 +++++++++++++++++++++++++++++----------
>  2 files changed, 35 insertions(+), 10 deletions(-)
>
> diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
> index b3a6a04..f0c6ca1 100644
> --- a/doc/ref/posix.texi
> +++ b/doc/ref/posix.texi
> @@ -2312,6 +2312,12 @@ terminate, and return the wait status code.  The 
> status is as per
>  (@pxref{Processes})
>  @end deffn
>  
> address@hidden {Scheme Procedure} close-pipe-output port
> +Close the output port of a pipe created by @code{open-pipe} with
> +mode @code{OPEN_BOTH}, and leave the input port open.  Return `#t' if
> +the port is closed successfully or `#f' if it was already closed.
> address@hidden deffn
> +
>  @sp 1
>  @code{waitpid WAIT_ANY} should not be used when pipes are open, since
>  it can reap a pipe's child process, causing an error from a subsequent
> diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
> index 7d0549e..2b014c5 100644
> --- a/module/ice-9/popen.scm
> +++ b/module/ice-9/popen.scm
> @@ -18,22 +18,32 @@
>  ;;;; 
>  
>  (define-module (ice-9 popen)
> -  :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe
> -        open-output-pipe open-input-output-pipe))
> +  :export (port/pid-table open-pipe* open-pipe close-pipe close-pipe-output
> +           open-input-pipe open-output-pipe open-input-output-pipe))
>  
>  (eval-when (load eval compile)
>    (load-extension (string-append "libguile-" (effective-version))
>                    "scm_init_popen"))
>  
> +;; a weak hash-table to store the write port of read-write pipes
> +;; just to be able to retrieve it in close-pipe-output.
> +(define rw/w-table (make-weak-key-hash-table 31))
> +
>  (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+"))
> +  (letrec ((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 ()
> +                     (hashq-remove! rw/w-table port)
> +                     (close-port read-port)
> +                     (or (port-closed? write-port)
> +                         (close-port write-port))))
> +                  "r+")))
> +    (hashq-set! rw/w-table port write-port)
> +    port))
>  
>  ;; a guardian to ensure the cleanup is done correctly when
>  ;; an open pipe is gc'd or a close-port is used.
> @@ -106,6 +116,15 @@ information on how to interpret this value."
>          (error "close-pipe: pipe not in table"))
>      (close-process (cons p pid))))
>  
> +(define (close-pipe-output pipe)
> +  "Closes the output port of a pipe created by @code{open-pipe} with
> +mode @code{OPEN_BOTH}, and leaves the input port open.  Returns `#t' if
> +it successfully closes the port or `#f' if it was already closed."
> +  (let ((port (hashq-ref rw/w-table pipe)))
> +    (unless port
> +      (error "close-pipe-output: pipe not in table"))
> +    (close-port port)))
> +
>  (define reap-pipes
>    (lambda ()
>      (let loop ((p (pipe-guardian)))