diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/build/bootloader.scm | 63 |
1 files changed, 62 insertions, 1 deletions
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm index d00674dd40..c5febcde1e 100644 --- a/gnu/build/bootloader.scm +++ b/gnu/build/bootloader.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,8 +18,15 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu build bootloader) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 binary-ports) - #:export (write-file-on-device)) + #: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)) ;;; @@ -35,3 +43,56 @@ (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)))))) |