aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-17 16:06:27 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-17 16:13:36 +0200
commit45d46223f92b0933aaf9b1392a21d09eaa1e2881 (patch)
treea9d316d8475240105f5b84f2b31bedfb1af97ea6
parent25c639e2a3b96204950f1ac8a92cb518783f0d61 (diff)
downloadguix-45d46223f92b0933aaf9b1392a21d09eaa1e2881.tar.gz
guix-45d46223f92b0933aaf9b1392a21d09eaa1e2881.zip
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).
-rw-r--r--gnu/build/bootloader.scm62
-rw-r--r--guix/build/utils.scm53
-rw-r--r--po/guix/POTFILES.in3
-rw-r--r--tests/build-utils.scm2
4 files changed, 55 insertions, 65 deletions
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 <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))))))
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).
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 5172345e5a..9c4b6dedb5 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -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
-
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 5678bb6a22..61e6c44e63 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -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)