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 2019-06-17 16:06:27 +02:00
parent 25c639e2a3
commit 45d46223f9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 55 additions and 65 deletions

View File

@ -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))))))

View File

@ -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).

View File

@ -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

View File

@ -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)