diff options
| -rw-r--r-- | gnu/build/bootloader.scm | 62 | ||||
| -rw-r--r-- | guix/build/utils.scm | 53 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 3 | ||||
| -rw-r--r-- | tests/build-utils.scm | 2 |
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) |