From 45d46223f92b0933aaf9b1392a21d09eaa1e2881 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Jun 2019 16:06:27 +0200 Subject: utils: Add 'invoke/quiet'. * gnu/build/bootloader.scm (G_): Remove. (open-pipe-with-stderr, invoke/quiet): Move to... * guix/build/utils.scm: ... here. Use 'let-values' instead of 'define-values' because Guile 2.0 (the bootstrap Guile) doesn't know about 'define-values'. * po/guix/POTFILES.in: Remove gnu/build/bootloader.scm, and add guix/build/utils.scm. * tests/build-utils.scm: Remove import of (gnu build bootloader). --- gnu/build/bootloader.scm | 62 +----------------------------------------------- 1 file changed, 1 insertion(+), 61 deletions(-) (limited to 'gnu/build') diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm index c5febcde1e..9570d6dd18 100644 --- a/gnu/build/bootloader.scm +++ b/gnu/build/bootloader.scm @@ -18,15 +18,8 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu build bootloader) - #:use-module (srfi srfi-34) - #:use-module (srfi srfi-35) #:use-module (ice-9 binary-ports) - #:use-module (ice-9 popen) - #:use-module (ice-9 match) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 format) - #:export (write-file-on-device - invoke/quiet)) + #:export (write-file-on-device)) ;;; @@ -43,56 +36,3 @@ (seek output offset SEEK_SET) (put-bytevector output bv)) #:binary #t))))) - -(define-syntax-rule (G_ str) str) ;for xgettext - -(define (open-pipe-with-stderr program . args) - "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect -both its standard output and standard error to the pipe. Return two value: -the pipe to read PROGRAM's data from, and the PID of the child process running -PROGRAM." - ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why - ;; we need to roll our own. - (match (pipe) - ((input . output) - (match (primitive-fork) - (0 - (dynamic-wind - (const #t) - (lambda () - (close-port input) - (dup2 (fileno output) 1) - (dup2 (fileno output) 2) - (apply execlp program program args)) - (lambda () - (primitive-exit 127)))) - (pid - (close-port output) - (values input pid)))))) - -;; TODO: Move to (guix build utils) on the next rebuild cycle. -(define (invoke/quiet program . args) - "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard -error. If PROGRAM succeeds, print nothing and return the unspecified value; -otherwise, raise a '&message' error condition that includes the status code -and the output of PROGRAM." - (define-values (pipe pid) - (apply open-pipe-with-stderr program args)) - - (let loop ((lines '())) - (match (read-line pipe) - ((? eof-object?) - (close-port pipe) - (match (waitpid pid) - ((_ . status) - (unless (zero? status) - (raise (condition - (&message - (message (format #f (G_ "'~a~{ ~a~}' exited with status ~a; \ -output follows:~%~%~{ ~a~%~}") - program args - (or (status:exit-val status) - status) - (reverse lines)))))))))) - (line - (loop (cons line lines)))))) -- cgit v1.2.3