From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Vladimir Zhbanov Newsgroups: gmane.lisp.guile.user Subject: Re: Pipes and processes, stdin, stdout and stderr Date: Tue, 14 Apr 2015 19:41:40 +0300 Message-ID: <20150414164140.GA5277@localhost.localdomain> References: <873842yahs.fsf@earlgrey.lan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="ReaqsoxgOBHFXBhH" X-Trace: ger.gmane.org 1429029728 10381 80.91.229.3 (14 Apr 2015 16:42:08 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 14 Apr 2015 16:42:08 +0000 (UTC) To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Tue Apr 14 18:42:07 2015 Return-path: Envelope-to: guile-user@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 1Yi3uY-0001go-DV for guile-user@m.gmane.org; Tue, 14 Apr 2015 18:42:06 +0200 Original-Received: from localhost ([::1]:56949 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yi3uX-0007gM-Px for guile-user@m.gmane.org; Tue, 14 Apr 2015 12:42:05 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43620) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yi3uL-0007g3-SX for guile-user@gnu.org; Tue, 14 Apr 2015 12:41:57 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Yi3uC-0001n9-Ri for guile-user@gnu.org; Tue, 14 Apr 2015 12:41:53 -0400 Original-Received: from mail-la0-x22d.google.com ([2a00:1450:4010:c03::22d]:35395) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yi3uC-0001lh-C1 for guile-user@gnu.org; Tue, 14 Apr 2015 12:41:44 -0400 Original-Received: by labbd9 with SMTP id bd9so12775196lab.2 for ; Tue, 14 Apr 2015 09:41:42 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=date:from:to:subject:message-id:mail-followup-to:references :mime-version:content-type:content-disposition:in-reply-to :user-agent; bh=3FrCifdQr3ECM5vJ0TCxiRReRfk3irm7GjPdfBGk/q8=; b=IKPfu88AVH/CBwJhajsGGbHiktAzOC8CbCRLFVUaqNIp6iCAU0MhBzG/zpUxKJy0gR +GteDAFKBx8qqTwSCw2ti9xmKGkg5jhYDh4G3ameS/b5dESWWIyILD+/zT089QLEBZwE i/T531y4P1GGQes7ONzRC7r7+Sda2120PXujU09XSXOD/MePg/weTtMXMSDHYG6wRHoA rR+LP3JchCqGIRzPqL8B8rcOp/SVlw6Bzh3MG4cCf+2LOXVufuCYCJ6EtMsuYI3bPDG+ vnqJzhl+Qkn2yXEMxx5uQsCwMZ3DT+ZH8Kueh18mKTzwesO3vaswX2tdIdX7NdUNpol7 xWkw== X-Received: by 10.112.210.2 with SMTP id mq2mr2639174lbc.17.1429029702452; Tue, 14 Apr 2015 09:41:42 -0700 (PDT) Original-Received: from newvzh.vzh ([178.234.51.66]) by mx.google.com with ESMTPSA id g19sm349790lbh.13.2015.04.14.09.41.41 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Tue, 14 Apr 2015 09:41:41 -0700 (PDT) Original-Received: from vovka by newvzh.vzh with local (Exim 4.83) (envelope-from ) id 1Yi3u8-00043Z-CV for guile-user@gnu.org; Tue, 14 Apr 2015 19:41:40 +0300 Mail-Followup-To: guile-user@gnu.org Content-Disposition: inline In-Reply-To: <873842yahs.fsf@earlgrey.lan> User-Agent: Mutt/1.5.23 (2014-03-12) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:4010:c03::22d X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:11797 Archived-At: --ReaqsoxgOBHFXBhH Content-Type: text/plain; charset=utf-8 Content-Disposition: inline Hi, Chris. In geda-gaf, I modified open-pipe* to solve a similar issue. See the procedure code and comments in attachment. Cheers, Vladimir --ReaqsoxgOBHFXBhH Content-Type: text/plain; charset=utf-8 Content-Disposition: attachment; filename="open-io-pipe.scm" ;; run a child process and return a pair of input and output ports. ;; Executes the program 'command' with optional arguments 'args' ;; (all strings) in a subprocess. ;; Two ports to the process (based on pipes) are created and ;; returned. ;; The procedure is a modified version of the popen open-pipe* ;; procedure. Its functionality is close to that of ;; open-input-output-pipe. Changes are made to make it return two ;; ports instead of one in order to have a possibility to close ;; each one separately. This allows closing of the input pipe by ;; using (close-port port) when needed and emit EOF to the running ;; child process. (define (gsch2pcb:open-io-pipe command . args) (let* ((c2p (pipe)) ; child to parent (p2c (pipe))) ; parent to child (setvbuf (cdr c2p) _IONBF) (setvbuf (cdr p2c) _IONBF) (let ((pid (primitive-fork))) (if (= pid 0) (begin ;; child process (ensure-batch-mode!) ;; select the three file descriptors to be used as ;; standard descriptors 0, 1, 2 for the new ;; process. They are pipes to/from the parent or taken ;; from the current Scheme input/output/error ports if ;; possible. (let ((input-fdes (fileno (car p2c))) (output-fdes (fileno (cdr c2p))) (error-fdes (or (false-if-exception (fileno (current-error-port))) (open-fdes *null-device* O_WRONLY)))) ;; close all file descriptors in ports inherited from ;; the parent except for the three selected above. ;; this is to avoid causing problems for other pipes in ;; the parent. ;; use low-level system calls, not close-port or the ;; scsh routines, to avoid side-effects such as ;; flushing port buffers or evicting ports. (port-for-each (lambda (pt-entry) (false-if-exception (let ((pt-fileno (fileno pt-entry))) (if (not (or (= pt-fileno input-fdes) (= pt-fileno output-fdes) (= pt-fileno error-fdes))) (close-fdes pt-fileno)))))) ;; Copy the three selected descriptors to the standard ;; descriptors 0, 1, 2, if not already there (if (not (= input-fdes 0)) (begin (if (= output-fdes 0) (set! output-fdes (dup->fdes 0))) (if (= error-fdes 0) (set! error-fdes (dup->fdes 0))) (dup2 input-fdes 0) ;; it's possible input-fdes is error-fdes (if (not (= input-fdes error-fdes)) (close-fdes input-fdes)))) (if (not (= output-fdes 1)) (begin (if (= error-fdes 1) (set! error-fdes (dup->fdes 1))) (dup2 output-fdes 1) ;; it's possible output-fdes is error-fdes (if (not (= output-fdes error-fdes)) (close-fdes output-fdes)))) (if (not (= error-fdes 2)) (begin (dup2 error-fdes 2) (close-fdes error-fdes))) (apply execlp command command args))) (begin ;; parent process ;; the forked child process should use these ports so ;; the parent process doesn't need them any more (close-port (cdr c2p)) (close-port (car p2c)) ;; return input and output ports (cons (car c2p) (cdr p2c)) ))))) --ReaqsoxgOBHFXBhH--