dannym pushed a commit to branch wip-installer-2
in repository guix.
commit 7eea11231df8596f187b2391316cf06106a2c826
Author: John Darrington <[email protected]>
Date: Mon Dec 26 15:22:12 2016 +0100
install: Define new procedure pipe-cmd and use it to implement window-pipe.
* gnu/system/installer/utils.scm (pipe-cmd): New procedure. (window-pipe)
reimplement.
---
gnu/system/installer/utils.scm | 20 +++++++++++++-------
1 file changed, 13 insertions(+), 7 deletions(-)
diff --git a/gnu/system/installer/utils.scm b/gnu/system/installer/utils.scm
index 5ea4964..b8e257d 100644
--- a/gnu/system/installer/utils.scm
+++ b/gnu/system/installer/utils.scm
@@ -39,6 +39,7 @@
find-mount-device
window-pipe
+ pipe-cmd
N_
@@ -68,11 +69,17 @@
(define* (window-pipe win cmd #:rest args)
"Run CMD ARGS ... sending stdout and stderr to WIN. Returns the exit status
of CMD."
- (let* ((windowp (make-window-port win))
+ (let* ((windowp (make-window-port win)))
+ (clear win)
+ (apply pipe-cmd windowp cmd args)
+ (close-port windowp)))
+
+(define* (pipe-cmd ipipe cmd #:rest args)
+ "Run CMD ARGS ... sending stdout and stderr to IPIPE. Returns the exit
status of CMD."
+ (let* (
(pipep (pipe))
(pid (primitive-fork)))
- (clear win)
(if (zero? pid)
(begin
(redirect-port (cdr pipep) (current-output-port))
@@ -81,11 +88,10 @@
(begin
(close (cdr pipep))
(let loop ((c (read-char (car pipep))))
- (if (not (eof-object? c))
- (begin
- (display c windowp)
- (force-output windowp)
- (loop (read-char (car pipep))))))))
+ (unless (eof-object? c)
+ (display c ipipe)
+ (force-output ipipe)
+ (loop (read-char (car pipep)))))))
(cdr (waitpid pid))))
