From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.bugs Subject: bug#15228: [PATCH] Close output port of I/O pipes Date: Tue, 21 Jun 2016 12:47:38 +0200 Message-ID: <87eg7q3jjp.fsf__18288.1386638202$1466506119$gmane$org@pobox.com> References: <1377937797.2030.5.camel@qwghlm> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1466506119 2908 80.91.229.3 (21 Jun 2016 10:48:39 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 21 Jun 2016 10:48:39 +0000 (UTC) Cc: 15228@debbugs.gnu.org, guile-devel@gnu.org To: Josep Portella Florit Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Tue Jun 21 12:48:29 2016 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 1bFJEB-0006Vq-Ly for guile-bugs@m.gmane.org; Tue, 21 Jun 2016 12:48:19 +0200 Original-Received: from localhost ([::1]:50713 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bFJEA-0002aO-UD for guile-bugs@m.gmane.org; Tue, 21 Jun 2016 06:48:18 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:60285) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bFJE0-0002YU-Ar for bug-guile@gnu.org; Tue, 21 Jun 2016 06:48:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bFJDu-0002eK-8B for bug-guile@gnu.org; Tue, 21 Jun 2016 06:48:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36261) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bFJDu-0002eF-4R for bug-guile@gnu.org; Tue, 21 Jun 2016 06:48:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1bFJDt-0006GK-UD for bug-guile@gnu.org; Tue, 21 Jun 2016 06:48:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Andy Wingo Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Tue, 21 Jun 2016 10:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 15228 X-GNU-PR-Package: guile X-GNU-PR-Keywords: patch Original-Received: via spool by 15228-submit@debbugs.gnu.org id=B15228.146650607424059 (code B ref 15228); Tue, 21 Jun 2016 10:48:01 +0000 Original-Received: (at 15228) by debbugs.gnu.org; 21 Jun 2016 10:47:54 +0000 Original-Received: from localhost ([127.0.0.1]:48598 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bFJDl-0006Fy-UV for submit@debbugs.gnu.org; Tue, 21 Jun 2016 06:47:54 -0400 Original-Received: from pb-sasl1.pobox.com ([64.147.108.66]:54932 helo=sasl.smtp.pobox.com) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bFJDh-0006Fm-NX for 15228@debbugs.gnu.org; Tue, 21 Jun 2016 06:47:51 -0400 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id 32A3D21FFA; Tue, 21 Jun 2016 06:47:46 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; s=sasl; bh=1dRu+Md9DRolO8utfvhorjOTAmI=; b=Yvb6L9 UdZrFiXheprpntjliajYX8ViEOxfwSwGpCJeM+1isfVozNlLEI3JwntsBziCcofd 4WusgC80NjxBRGBMFcGsnnQcTXe8Kt4IxyFI8zOT0aRbTpi+fVlRVXnslb7pdfwl Ofy6bHxdbTkyGAVzKg/O0IzEP+AwqFJf3J/98= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; q=dns; s=sasl; b=hSSx9zR5iz5alQ/2Cd5cqERHjbsG0bpX HAKT5j6W90HCciaSYL/0qqfh1/Sl4AzI8BPUlMPutDeO+DbCrCRQl34TQAJFmOnV H8j6qD0cvO4d63iict1kFDZdP9QNnjt68wiHsvi73/sbmbvVks+1j7qjY0i3k81j TcQmRZJFE/8= Original-Received: from pb-sasl1.nyi.icgroup.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id 2A4FD21FF9; Tue, 21 Jun 2016 06:47:46 -0400 (EDT) Original-Received: from clucks (unknown [88.160.190.192]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by pb-sasl1.pobox.com (Postfix) with ESMTPSA id 2AA8321FF8; Tue, 21 Jun 2016 06:47:45 -0400 (EDT) In-Reply-To: <1377937797.2030.5.camel@qwghlm> (Josep Portella Florit's message of "Sat, 31 Aug 2013 10:29:57 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) X-Pobox-Relay-ID: 966ECC94-379D-11E6-8B44-C1836462E9F6-02397024!pb-sasl1.pobox.com X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.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" Xref: news.gmane.org gmane.lisp.guile.bugs:8072 Archived-At: 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 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 = # > 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)))