diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-06-17 16:06:27 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-17 16:13:36 +0200 |
commit | 45d46223f92b0933aaf9b1392a21d09eaa1e2881 (patch) | |
tree | a9d316d8475240105f5b84f2b31bedfb1af97ea6 /guix | |
parent | 25c639e2a3b96204950f1ac8a92cb518783f0d61 (diff) |
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).
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/utils.scm | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm index b7cd748d81..b8be73ead4 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -106,6 +106,8 @@ invoke-error-stop-signal report-invoke-error + invoke/quiet + locale-category->string)) @@ -666,6 +668,57 @@ way." (invoke-error-term-signal c) (invoke-error-stop-signal c)))) +(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)))))) + +(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." + (let-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) + (let-syntax ((G_ (syntax-rules () ;for xgettext + ((_ str) str)))) + (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))))))) + ;;; ;;; Text substitution (aka. sed). |