GNU bug report logs - #15228
[PATCH] Close output port of I/O pipes

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guile; Reported by: Josep Portella Florit <jpf@HIDDEN>; Keywords: patch; dated Sat, 31 Aug 2013 08:31:01 UTC; Maintainer for guile is bug-guile@HIDDEN.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 31 Aug 2013 08:30:56 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sat Aug 31 04:30:56 2013
Received: from localhost ([127.0.0.1]:60996 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.80)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1VFga7-0000FY-1c
	for submit <at> debbugs.gnu.org; Sat, 31 Aug 2013 04:30:55 -0400
Received: from eggs.gnu.org ([208.118.235.92]:49043)
 by debbugs.gnu.org with esmtp (Exim 4.80)
 (envelope-from <jpf@HIDDEN>) id 1VFga3-00006O-Hm
 for submit <at> debbugs.gnu.org; Sat, 31 Aug 2013 04:30:52 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <jpf@HIDDEN>) id 1VFgZo-0001A9-R5
 for submit <at> debbugs.gnu.org; Sat, 31 Aug 2013 04:30:46 -0400
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled
 version=3.3.2
Received: from lists.gnu.org ([2001:4830:134:3::11]:49050)
 by eggs.gnu.org with esmtp (Exim 4.71)
 (envelope-from <jpf@HIDDEN>) id 1VFgZo-0001A4-NY
 for submit <at> debbugs.gnu.org; Sat, 31 Aug 2013 04:30:36 -0400
Received: from eggs.gnu.org ([2001:4830:134:3::10]:50746)
 by lists.gnu.org with esmtp (Exim 4.71)
 (envelope-from <jpf@HIDDEN>) id 1VFgZg-0002bx-WA
 for bug-guile@HIDDEN; Sat, 31 Aug 2013 04:30:36 -0400
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <jpf@HIDDEN>) id 1VFgZL-00013z-QH
 for bug-guile@HIDDEN; Sat, 31 Aug 2013 04:30:28 -0400
Received: from primfilat.com ([71.19.154.166]:43381)
 by eggs.gnu.org with esmtp (Exim 4.71)
 (envelope-from <jpf@HIDDEN>) id 1VFgZL-00010T-Ez
 for bug-guile@HIDDEN; Sat, 31 Aug 2013 04:30:07 -0400
Received: from [192.168.0.102] (unknown [46.18.40.145])
 by primfilat.com (Postfix) with ESMTPSA id 5B0E67B8A0
 for <bug-guile@HIDDEN>; Sat, 31 Aug 2013 10:44:02 +0200 (CEST)
Message-ID: <1377937797.2030.5.camel@qwghlm>
Subject: [PATCH] Close output port of I/O pipes
From: Josep Portella Florit <jpf@HIDDEN>
To: bug-guile@HIDDEN
Date: Sat, 31 Aug 2013 10:29:57 +0200
Content-Type: text/plain; charset="UTF-8"
X-Mailer: Evolution 3.2.3-0ubuntu6+6.0trisquel1 
Content-Transfer-Encoding: 7bit
Mime-Version: 1.0
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [generic]
X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address
 (bad octet value).
X-Received-From: 2001:4830:134:3::11
X-Spam-Score: -2.4 (--)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.15
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <http://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <http://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <http://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.4 (--)

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
 
+@deffn {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.
+@end 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)))
-- 
1.7.9.5






Acknowledgement sent to Josep Portella Florit <jpf@HIDDEN>:
New bug report received and forwarded. Copy sent to bug-guile@HIDDEN. Full text available.
Report forwarded to bug-guile@HIDDEN:
bug#15228; Package guile. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Fri, 31 Oct 2014 17:00:04 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.