From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Josep Portella Florit Newsgroups: gmane.lisp.guile.bugs Subject: bug#15228: [PATCH] Close output port of I/O pipes Date: Sat, 31 Aug 2013 10:29:57 +0200 Message-ID: <1377937797.2030.5.camel@qwghlm> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: 7bit X-Trace: ger.gmane.org 1377937889 700 80.91.229.3 (31 Aug 2013 08:31:29 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 31 Aug 2013 08:31:29 +0000 (UTC) To: 15228@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Sat Aug 31 10:31:30 2013 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VFgac-0006TM-SL for guile-bugs@m.gmane.org; Sat, 31 Aug 2013 10:31:27 +0200 Original-Received: from localhost ([::1]:53868 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VFgac-0002es-7m for guile-bugs@m.gmane.org; Sat, 31 Aug 2013 04:31:26 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50816) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VFgaP-0002cp-MG for bug-guile@gnu.org; Sat, 31 Aug 2013 04:31:23 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VFgaG-0001Bp-8R for bug-guile@gnu.org; Sat, 31 Aug 2013 04:31:13 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:52703) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VFgaG-0001Bl-5R for bug-guile@gnu.org; Sat, 31 Aug 2013 04:31:04 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1VFgaF-0000MD-2L for bug-guile@gnu.org; Sat, 31 Aug 2013 04:31:03 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Josep Portella Florit Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sat, 31 Aug 2013 08:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 15228 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-guile@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.13779378561056 (code B ref -1); Sat, 31 Aug 2013 08:31:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 31 Aug 2013 08:30:56 +0000 Original-Received: from localhost ([127.0.0.1]:60996 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VFga7-0000FY-1c for submit@debbugs.gnu.org; Sat, 31 Aug 2013 04:30:55 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:49043) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VFga3-00006O-Hm for submit@debbugs.gnu.org; Sat, 31 Aug 2013 04:30:52 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VFgZo-0001A9-R5 for submit@debbugs.gnu.org; Sat, 31 Aug 2013 04:30:46 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:49050) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VFgZo-0001A4-NY for submit@debbugs.gnu.org; Sat, 31 Aug 2013 04:30:36 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50746) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VFgZg-0002bx-WA for bug-guile@gnu.org; Sat, 31 Aug 2013 04:30:36 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VFgZL-00013z-QH for bug-guile@gnu.org; Sat, 31 Aug 2013 04:30:28 -0400 Original-Received: from primfilat.com ([71.19.154.166]:43381) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VFgZL-00010T-Ez for bug-guile@gnu.org; Sat, 31 Aug 2013 04:30:07 -0400 Original-Received: from [192.168.0.102] (unknown [46.18.40.145]) by primfilat.com (Postfix) with ESMTPSA id 5B0E67B8A0 for ; Sat, 31 Aug 2013 10:44:02 +0200 (CEST) X-Mailer: Evolution 3.2.3-0ubuntu6+6.0trisquel1 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-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:7270 Archived-At: 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 = # scheme@(ice-9 popen)> (define p (open-pipe "md5sum" OPEN_BOTH)) scheme@(ice-9 popen)> rw/w-table $4 = # scheme@(ice-9 popen)> (set! p #f) scheme@(ice-9 popen)> (gc) scheme@(ice-9 popen)> rw/w-table $5 = # 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