Hi,
Ludovic Courtès <ludovic.cour...@inria.fr> skribis:
> ‘guix pull’ & co. show raw “detailed log” output for things
> built/downloaded while building ‘compute-guix-derivation.drv’:
>
> $ guix time-machine -- build …
> Updating channel 'guix' from Git repository at
> 'https://git.savannah.gnu.org/git/guix.git'...
[...]
> @ substituter-started
> /gnu/store/frg642g7pxh95cdahar2s884ig82i1xn-nghttp2-1.41.0-lib substitute
> @ substituter-started
> /gnu/store/v5rgf8v6cjxjbngkzjcznj98dkxj8svg-jansson-2.12 substitute
> @ substituter-started /gnu/store/23d9f16wbv22qin71ac32hql81bzzkab-libev-4.31
> substitute
> @ download-started /gnu/store/23d9f16wbv22qin71ac32hql81bzzkab-libev-4.31
> https://ci.guix.gnu.org/nar/lzip/23d9f16wbv22qin71ac32hql81bzzkab-libev-4.31
> 124297
> @ download-started /gnu/store/v5rgf8v6cjxjbngkzjcznj98dkxj8svg-jansson-2.12
> https://ci.guix.gnu.org/nar/lzip/v5rgf8v6cjxjbngkzjcznj98dkxj8svg-jansson-2.12
> 27840
The attached patch fixes that in an unimaginative but efficient fashion:
1. the parent process (which runs ‘build-self.scm’) accepts connections on
a named socket;
2. the ‘compute-guix-derivation’ process connects to that socket and
sends it its raw build output (what we see in the snippet above);
3. the parent process reads that and sends it to its own
(current-build-output-port); that port processes those “@” build
traces according to the current ‘--verbosity’—see (guix status).
With this in place, builds or downloads triggered during the evaluation
of ‘compute-guix-derivation’ are reported in a consistent way from a UI
viewpoint.
There was one remaining glitch: the spinner that
‘compute-guix-derivation’ prints would show up in the middle of the
prettified build output. The second patch addresses that.
Feedback welcome!
Ludo’.
>From 882c47b51223c6002eaec79466106a29ac84c613 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Tue, 30 Mar 2021 16:07:26 +0200
Subject: [PATCH 1/2] build-self: Forward sub-process build output to
(current-build-output-port).
Fixes <https://bugs.gnu.org/41930>.
* build-aux/build-self.scm (build-program): Add extra 'build-output'
parameter. Interpret it as a socket name and connect to it; use it as
the CURRENT-BUILD-OUTPUT-PORT.
(proxy): New procedure.
(build): Open a named socket. Accept connections and call 'proxy' on it.
---
build-aux/build-self.scm | 90 +++++++++++++++++++++++++++++-----------
1 file changed, 65 insertions(+), 25 deletions(-)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index dd845d1596..3e057ca5d2 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -336,7 +336,8 @@ interface (FFI) of Guile.")
(loop (cdr spin)))))
(match (command-line)
- ((_ source system version protocol-version)
+ ((_ source system version protocol-version
+ build-output)
;; The current input port normally wraps a file
;; descriptor connected to the daemon, or it is
;; connected to /dev/null. In the former case, reuse
@@ -349,16 +350,22 @@ interface (FFI) of Guile.")
(current-input-port)
"w+0")
#:version proto)
- (open-connection))))
+ (open-connection)))
+ (sock (socket AF_UNIX SOCK_STREAM 0)))
(call-with-new-thread
(lambda ()
(spin system)))
+ ;; Connect to BUILD-OUTPUT and send it the raw
+ ;; build output.
+ (connect sock AF_UNIX build-output)
+
(display
(and=>
;; Silence autoload warnings and the likes.
(parameterize ((current-warning-port
- (%make-void-port "w")))
+ (%make-void-port "w"))
+ (current-build-output-port sock))
(run-with-store store
(guix-derivation source version
#$guile-version
@@ -370,6 +377,20 @@ interface (FFI) of Guile.")
derivation-file-name))))))
#:module-path (list source))))
+(define (proxy input output)
+ "Dump the contents of INPUT to OUTPUT until EOF is reached on INPUT."
+ (setvbuf input 'block 16384)
+ (let loop ()
+ (match (select (list input) '() '())
+ ((() () ())
+ (loop))
+ (((_) () ())
+ ;; Read from INPUT as much as can be read without blocking.
+ (let ((bv (get-bytevector-some input)))
+ (unless (eof-object? bv)
+ (put-bytevector output bv)
+ (loop)))))))
+
(define (call-with-clean-environment thunk)
(let ((env (environ)))
(dynamic-wind
@@ -426,7 +447,14 @@ files."
;; way, we know 'open-pipe*' will not close it on 'exec'. If PORT is
;; not a file port (e.g., it's an SSH channel), then the subprocess's
;; stdin will actually be /dev/null.
- (let* ((pipe (with-input-from-port port
+ (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
+ (node (let ((file (string-append (or (getenv "TMPDIR") "/tmp")
+ "/guix-build-output-"
+ (number->string (getpid)))))
+ (bind sock AF_UNIX file)
+ (listen sock 1)
+ file))
+ (pipe (with-input-from-port port
(lambda ()
;; Make sure BUILD is not influenced by
;; $GUILE_LOAD_PATH & co.
@@ -442,30 +470,42 @@ files."
(if (file-port? port)
(number->string
(logior major minor))
- "none"))))))
- (str (get-string-all pipe))
- (status (close-pipe pipe)))
- (match str
- ((? eof-object?)
- (error "build program failed" (list build status)))
- ((? derivation-path? drv)
- (mbegin %store-monad
- (return (newline (current-error-port)))
- ((store-lift add-temp-root) drv)
- (return (read-derivation-from-file drv))))
- ("#f"
- ;; Unsupported PULL-VERSION.
- (return #f))
- ((? string? str)
- (raise (condition
- (&message
- (message (format #f "You found a bug: the program '~a'
+ "none")
+ node))))))
+ ;; Wait for a connection on SOCK and proxy build output so it can be
+ ;; processed according to the settings currently in effect (build
+ ;; traces, verbosity level, and so on).
+ (match (accept sock)
+ ((port . _)
+ (close-port sock)
+ (delete-file node)
+ (proxy port (current-build-output-port))))
+
+ ;; Now that the build output connection was closed, read the result, a
+ ;; derivation file name, from PIPE.
+ (let ((str (get-string-all pipe))
+ (status (close-pipe pipe)))
+ (match str
+ ((? eof-object?)
+ (error "build program failed" (list build status)))
+ ((? derivation-path? drv)
+ (mbegin %store-monad
+ (return (newline (current-error-port)))
+ ((store-lift add-temp-root) drv)
+ (return (read-derivation-from-file drv))))
+ ("#f"
+ ;; Unsupported PULL-VERSION.
+ (return #f))
+ ((? string? str)
+ (raise (condition
+ (&message
+ (message (format #f "You found a bug: the program '~a'
failed to compute the derivation for Guix (version: ~s; system: ~s;
host version: ~s; pull-version: ~s).
Please report it by email to <~a>.~%"
- (derivation->output-path build)
- version system %guix-version pull-version
- %guix-bug-report-address)))))))))))
+ (derivation->output-path build)
+ version system %guix-version pull-version
+ %guix-bug-report-address))))))))))))
;; This file is loaded by 'guix pull'; return it the build procedure.
build
--
2.31.0
>From 7710dca2453667f61f866be0115d632efa93a3b3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <l...@gnu.org>
Date: Tue, 30 Mar 2021 16:35:05 +0200
Subject: [PATCH 2/2] build-self: Take care of the spinner in the parent
process.
This simplifies code and mostly ensures we don't print a spinner while
there's build activity going on.
* build-aux/build-self.scm (build-program): Remove 'spin' and
'call-with-new-thread' call from "compute-guix-derivation" body. Remove
"Computing Guix derivation" message.
(proxy): Pass extra argument to 'select'. Display a spinner when
'select' returns empty lists.
(build): Print "Computing Guix derivation" message here.
---
build-aux/build-self.scm | 43 ++++++++++++++++------------------------
1 file changed, 17 insertions(+), 26 deletions(-)
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 3e057ca5d2..853a2f328f 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -285,8 +285,7 @@ interface (FFI) of Guile.")
#:select? select?))
(gexp->script "compute-guix-derivation"
#~(begin
- (use-modules (ice-9 match)
- (ice-9 threads))
+ (use-modules (ice-9 match))
(eval-when (expand load eval)
;; (gnu packages …) modules are going to be looked up
@@ -320,21 +319,6 @@ interface (FFI) of Guile.")
(guix derivations)
(srfi srfi-1))
- (define (spin system)
- (define spin
- (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/"))
-
- (format (current-error-port)
- "Computing Guix derivation for '~a'... "
- system)
- (when (isatty? (current-error-port))
- (let loop ((spin spin))
- (display (string-append "\b" (car spin))
- (current-error-port))
- (force-output (current-error-port))
- (sleep 1)
- (loop (cdr spin)))))
-
(match (command-line)
((_ source system version protocol-version
build-output)
@@ -352,10 +336,6 @@ interface (FFI) of Guile.")
#:version proto)
(open-connection)))
(sock (socket AF_UNIX SOCK_STREAM 0)))
- (call-with-new-thread
- (lambda ()
- (spin system)))
-
;; Connect to BUILD-OUTPUT and send it the raw
;; build output.
(connect sock AF_UNIX build-output)
@@ -378,18 +358,26 @@ interface (FFI) of Guile.")
#:module-path (list source))))
(define (proxy input output)
- "Dump the contents of INPUT to OUTPUT until EOF is reached on INPUT."
+ "Dump the contents of INPUT to OUTPUT until EOF is reached on INPUT.
+Display a spinner when nothing happens."
+ (define spin
+ (circular-list "-" "\\" "|" "/" "-" "\\" "|" "/"))
+
(setvbuf input 'block 16384)
- (let loop ()
- (match (select (list input) '() '())
+ (let loop ((spin spin))
+ (match (select (list input) '() '() 1)
((() () ())
- (loop))
+ (when (isatty? (current-error-port))
+ (display (string-append "\b" (car spin))
+ (current-error-port))
+ (force-output (current-error-port)))
+ (loop (cdr spin)))
(((_) () ())
;; Read from INPUT as much as can be read without blocking.
(let ((bv (get-bytevector-some input)))
(unless (eof-object? bv)
(put-bytevector output bv)
- (loop)))))))
+ (loop spin)))))))
(define (call-with-clean-environment thunk)
(let ((env (environ)))
@@ -472,6 +460,9 @@ files."
(logior major minor))
"none")
node))))))
+ (format (current-error-port) "Computing Guix derivation for '~a'... "
+ system)
+
;; Wait for a connection on SOCK and proxy build output so it can be
;; processed according to the settings currently in effect (build
;; traces, verbosity level, and so on).
--
2.31.0
