From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: Re: open-pipe fd duplications Date: Fri, 19 Sep 2003 11:06:10 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <8765jp1ta5.fsf@zip.com.au> References: <87lluikzxt.fsf@zip.com.au> <87d6e2i5ke.fsf@zagadka.ping.de> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1063933663 28380 80.91.224.253 (19 Sep 2003 01:07:43 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 19 Sep 2003 01:07:43 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Fri Sep 19 03:07:41 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1A09kK-0005Fg-00 for ; Fri, 19 Sep 2003 03:07:40 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.22) id 1A09jF-00027v-KW for guile-devel@m.gmane.org; Thu, 18 Sep 2003 21:06:33 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.22) id 1A09j8-00027p-Em for guile-devel@gnu.org; Thu, 18 Sep 2003 21:06:26 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.22) id 1A09j6-00027Y-MR for guile-devel@gnu.org; Thu, 18 Sep 2003 21:06:25 -0400 Original-Received: from [61.8.0.36] (helo=snoopy.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.22) id 1A09j5-00027T-Qs for guile-devel@gnu.org; Thu, 18 Sep 2003 21:06:24 -0400 Original-Received: from mongrel.pacific.net.au (mongrel.pacific.net.au [61.8.0.107]) by snoopy.pacific.net.au (8.12.3/8.12.3/Debian-6.4) with ESMTP id h8J16LBt013074 for ; Fri, 19 Sep 2003 11:06:21 +1000 Original-Received: from localhost (ppp113.dyn228.pacific.net.au [203.143.228.113]) by mongrel.pacific.net.au (8.12.3/8.12.3/Debian-6.4) with ESMTP id h8J144xd029206 for ; Fri, 19 Sep 2003 11:04:06 +1000 Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 1A09it-0001do-00; Fri, 19 Sep 2003 11:06:11 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never User-Agent: Gnus/5.1003 (Gnus v5.10.3) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:2808 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2808 --=-=-= Marius Vollmer writes: > > Can you make that change? Yep, applied. I realized I botched the first effort actually, didn't pay attention to the comment ... * popen.scm (open-process): Correction to previous fdes closing change, need to watch out for stdin==stderr or stdout==stderr. I added some tests, both of this and of the original problem. --=-=-= Content-Disposition: attachment; filename=popen.scm.close-2.diff --- popen.scm.~1.12.~ 1970-01-01 10:00:01.000000000 +1000 +++ popen.scm 2003-09-16 21:46:52.000000000 +1000 @@ -81,9 +81,8 @@ (= pt-fileno error-fdes))) (close-fdes pt-fileno)))))) - ;; copy the three selected descriptors to the standard - ;; descriptors 0, 1, 2. note that it's possible that - ;; output-fdes or input-fdes is equal to error-fdes. + ;; Copy the three selected descriptors to the standard + ;; descriptors 0, 1, 2, if not already there (cond ((not (= input-fdes 0)) (if (= output-fdes 0) @@ -91,13 +90,17 @@ (if (= error-fdes 0) (set! error-fdes (dup->fdes 0))) (dup2 input-fdes 0) - (close-fdes input-fdes))) - + ;; it's possible input-fdes is error-fdes + (if (not (= input-fdes error-fdes)) + (close-fdes input-fdes)))) + (cond ((not (= output-fdes 1)) (if (= error-fdes 1) (set! error-fdes (dup->fdes 1))) (dup2 output-fdes 1) - (close-fdes output-fdes))) + ;; it's possible output-fdes is error-fdes + (if (not (= output-fdes error-fdes)) + (close-fdes output-fdes)))) (cond ((not (= error-fdes 2)) (dup2 error-fdes 2) --=-=-= Content-Disposition: attachment; filename=popen.test ;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*- ;;;; ;;;; Copyright 2003 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 2.1 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA (define-module (test-suite test-ice-9-popen) #:use-module (test-suite lib) #:use-module (ice-9 popen)) ;; read from PORT until eof is reached, return what's read as a string (define (read-string-to-eof port) (do ((lst '() (cons c lst)) (c (read-char port) (read-char port))) ((eof-object? c) (list->string (reverse! lst))))) ;; call (THUNK), with SIGPIPE set to SIG_IGN so that an EPIPE error is ;; generated rather than a SIGPIPE signal (define (with-epipe thunk) (dynamic-wind (lambda () (sigaction SIGPIPE SIG_IGN)) thunk restore-signals)) ;; ;; open-input-pipe ;; (with-test-prefix "open-input-pipe" (pass-if-exception "no args" exception:wrong-num-args (open-input-pipe)) (pass-if "port?" (port? (open-input-pipe "echo hello"))) (pass-if "echo hello" (string=? "hello\n" (read-string-to-eof (open-input-pipe "echo hello")))) ;; exercise file descriptor setups when stdin is the same as stderr (pass-if "stdin==stderr" (let ((port (open-file "/dev/null" "r+"))) (with-input-from-port port (lambda () (with-error-to-port port (lambda () (open-input-pipe "echo hello")))))) #t) ;; exercise file descriptor setups when stdout is the same as stderr (pass-if "stdout==stderr" (let ((port (open-file "/dev/null" "r+"))) (with-output-to-port port (lambda () (with-error-to-port port (lambda () (open-input-pipe "echo hello")))))) #t) ;; After the child closes stdout (which it indicates here by writing ;; "closed" to stderr), the parent should see eof. In Guile 1.6.4 and ;; earlier a duplicate of stdout existed in the child, meaning eof was not ;; seen. (pass-if "no duplicate" (let* ((pair (pipe)) (port (with-error-to-port (cdr pair) (lambda () (open-input-pipe "exec 1>/dev/null; echo closed 1>&2; sleep 999"))))) (read-char (car pair)) ;; wait for child to do its thing (and (char-ready? port) (eof-object? (read-char port)))))) ;; ;; open-output-pipe ;; (with-test-prefix "open-output-pipe" (pass-if-exception "no args" exception:wrong-num-args (open-output-pipe)) (pass-if "port?" (port? (open-output-pipe "exit 0"))) ;; exercise file descriptor setups when stdout is the same as stderr (pass-if "stdin==stderr" (let ((port (open-file "/dev/null" "r+"))) (with-input-from-port port (lambda () (with-error-to-port port (lambda () (open-output-pipe "exit 0")))))) #t) ;; exercise file descriptor setups when stdout is the same as stderr (pass-if "stdout==stderr" (let ((port (open-file "/dev/null" "r+"))) (with-output-to-port port (lambda () (with-error-to-port port (lambda () (open-output-pipe "exit 0")))))) #t) ;; After the child closes stdin (which it indicates here by writing ;; "closed" to stderr), the parent should see a broken pipe. We setup to ;; see this as EPIPE (rather than SIGPIPE). In Guile 1.6.4 and earlier a ;; duplicate of stdin existed in the child, preventing the broken pipe ;; occurring. (pass-if "no duplicate" (with-epipe (lambda () (let* ((pair (pipe)) (port (with-error-to-port (cdr pair) (lambda () (open-output-pipe "exec 0&2; sleep 999"))))) (read-char (car pair)) ;; wait for child to do its thing (catch 'system-error (lambda () (write-char #\x port) (force-output port) #f) (lambda (key name fmt args errno-list) (= (car errno-list) EPIPE)))))))) ;; ;; close-pipe ;; (with-test-prefix "open-output-pipe" (pass-if-exception "no args" exception:wrong-num-args (close-pipe)) (pass-if "exit 0" (let ((st (close-pipe (open-output-pipe "exit 0")))) (and (status:exit-val st) (= 0 (status:exit-val st))))) (pass-if "exit 1" (let ((st (close-pipe (open-output-pipe "exit 1")))) (and (status:exit-val st) (= 1 (status:exit-val st)))))) --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--