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).
This commit is contained in:
Ludovic Courtès
parent
25c639e2a3
commit
45d46223f9
|
|
@ -18,15 +18,8 @@
|
|||
;;; 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)
|
||||
#: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))))))
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ gnu/installer/timezone.scm
|
|||
gnu/installer/user.scm
|
||||
gnu/installer/utils.scm
|
||||
gnu/packages/bootstrap.scm
|
||||
guix/build/utils.scm
|
||||
guix/scripts.scm
|
||||
guix/scripts/build.scm
|
||||
guix/discovery.scm
|
||||
|
|
@ -79,6 +80,4 @@ guix/channels.scm
|
|||
guix/profiles.scm
|
||||
guix/git.scm
|
||||
guix/deprecation.scm
|
||||
gnu/build/bootloader.scm
|
||||
nix/nix-daemon/guix-daemon.cc
|
||||
|
||||
|
|
|
|||
|
|
@ -21,8 +21,6 @@
|
|||
(define-module (test-build-utils)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module ((gnu build bootloader)
|
||||
#:select (invoke/quiet))
|
||||
#:use-module ((guix utils)
|
||||
#:select (%current-system call-with-temporary-directory))
|
||||
#:use-module (gnu packages)
|
||||
|
|
|
|||
Loading…
Reference in New Issue