01/01: SQUASHME: Check whether the daemon supports "extended build traces".

[Ludovic Courtès]

civodul pushed a commit to branch wip-ui
in repository guix.

commit 8ee066a993c058ba91a977085706b8c6c2e428a5
Author: Ludovic Courtès <address@hidden>
Date:   Thu Sep 27 11:52:47 2018 +0200

    SQUASHME: Check whether the daemon supports "extended build traces".
    
    Suggested by Ricardo.
    
    * nix/libstore/worker-protocol.hh (PROTOCOL_VERSION): Bump to 0x162.
    * guix/store.scm (%protocol-version): Bump.
    (protocol-version, nix-server-version): New procedures.
    (current-store-protocol-version): New variable.
    (with-store, build-things): Parameterize it.
    * guix/status.scm (extended-build-trace-supported?): New procedure.
---
 guix/status.scm                 | 21 ++++++++++++++++++---
 guix/store.scm                  | 39 ++++++++++++++++++++++++++++++---------
 nix/libstore/worker-protocol.hh |  2 +-
 3 files changed, 49 insertions(+), 13 deletions(-)

diff --git a/guix/status.scm b/guix/status.scm
index 6072789..96abc8f 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -23,7 +23,9 @@
   #:use-module (guix progress)
   #:autoload   (guix build syscalls) (terminal-columns)
   #:use-module ((guix store)
-                #:select (current-build-output-port log-file))
+                #:select (current-build-output-port
+                          current-store-protocol-version
+                          log-file))
   #:use-module (guix derivations)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -205,6 +207,18 @@ compute a new status based on STATUS."
   (+ (length (build-status-building status))
      (length (build-status-downloading status))))
 
+
+;;;
+;;; Rendering.
+;;;
+
+(define (extended-build-trace-supported?)
+  "Return true if the currently used store is known to support \"extended
+build traces\" such as \"@ download-progress\" traces."
+  ;; Support for extended build traces was added in protocol version #x162.
+  (and (current-store-protocol-version)
+       (>= (current-store-protocol-version) #x162)))
+
 (define spin!
   (let ((steps (circular-list "\\" "|" "/" "-")))
     (lambda (port)
@@ -321,7 +335,7 @@ addition to build events."
      (format port (info (G_ "View build log at '~a'.~%"))
              (log-file #f drv)))
     (('substituter-started item _ ...)
-     (when print-log?
+     (when (or print-log? (not (extended-build-trace-supported?)))
        (format port (info (G_ "substituting ~a...")) item)
        (newline port)))
     (('download-started item uri _ ...)
@@ -344,7 +358,8 @@ addition to build events."
     (('substituter-succeeded item _ ...)
      ;; If there are no jobs running, we already reported download completion
      ;; sot there's nothing left to do.
-     (unless (zero? (simultaneous-jobs status))
+     (unless (and (zero? (simultaneous-jobs status))
+                  (extended-build-trace-supported?))
        (format port (success (G_ "substitution of ~a complete")) item)
        (newline port)))
     (('substituter-failed item _ ...)
diff --git a/guix/store.scm b/guix/store.scm
index 3e9835d..4531b3a 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -50,9 +50,11 @@
             %default-substitute-urls
 
             nix-server?
+            nix-server-version
             nix-server-major-version
             nix-server-minor-version
             nix-server-socket
+            current-store-protocol-version        ;for internal use
 
             &nix-error nix-error?
             &nix-connection-error nix-connection-error?
@@ -152,7 +154,7 @@
             direct-store-path
             log-file))
 
-(define %protocol-version #x161)
+(define %protocol-version #x162)
 
 (define %worker-magic-1 #x6e697863)               ; "nixc"
 (define %worker-magic-2 #x6478696f)               ; "dxio"
@@ -161,6 +163,8 @@
   (logand magic #xff00))
 (define (protocol-minor magic)
   (logand magic #x00ff))
+(define (protocol-version major minor)
+  (logior major minor))
 
 (define-syntax define-enumerate-type
   (syntax-rules ()
@@ -540,6 +544,11 @@ connection.  Use with care."
                       (make-hash-table 100)
                       (make-hash-table 100))))
 
+(define (nix-server-version store)
+  "Return the protocol version of STORE as an integer."
+  (protocol-version (nix-server-major-version store)
+                    (nix-server-minor-version store)))
+
 (define (write-buffered-output server)
   "Flush SERVER's output port."
   (force-output (nix-server-output-port server))
@@ -556,10 +565,20 @@ automatically close the store when the dynamic extent of 
EXP is left."
     (dynamic-wind
       (const #f)
       (lambda ()
-        exp ...)
+        (parameterize ((current-store-protocol-version
+                        (nix-server-version store)))
+         exp) ...)
       (lambda ()
         (false-if-exception (close-connection store))))))
 
+(define current-store-protocol-version
+  ;; Protocol version of the store currently used.  XXX: This is a hack to
+  ;; communicate the protocol version to the build output port.  It's a hack
+  ;; because it could be inaccurrate, for instance if there's code that
+  ;; manipulates several store connections at once; it works well for the
+  ;; purposes of (guix status) though.
+  (make-parameter #f))
+
 (define current-build-output-port
   ;; The port where build output is sent.
   (make-parameter (current-error-port)))
@@ -1073,13 +1092,15 @@ an arbitrary directory layout in the store without 
creating a derivation."
 outputs, and return when the worker is done building them.  Elements of THINGS
 that are not derivations can only be substituted and not built locally.
 Return #t on success."
-      (if (>= (nix-server-minor-version store) 15)
-          (build store things mode)
-          (if (= mode (build-mode normal))
-              (build/old store things)
-              (raise (condition (&nix-protocol-error
-                                 (message "unsupported build mode")
-                                 (status  1)))))))))
+      (parameterize ((current-store-protocol-version
+                      (nix-server-version store)))
+        (if (>= (nix-server-minor-version store) 15)
+            (build store things mode)
+            (if (= mode (build-mode normal))
+                (build/old store things)
+                (raise (condition (&nix-protocol-error
+                                   (message "unsupported build mode")
+                                   (status  1))))))))))
 
 (define-operation (add-temp-root (store-path path))
   "Make PATH a temporary root for the duration of the current session.
diff --git a/nix/libstore/worker-protocol.hh b/nix/libstore/worker-protocol.hh
index efe9ead..103d60a 100644
--- a/nix/libstore/worker-protocol.hh
+++ b/nix/libstore/worker-protocol.hh
@@ -6,7 +6,7 @@ namespace nix {
 #define WORKER_MAGIC_1 0x6e697863
 #define WORKER_MAGIC_2 0x6478696f
 
-#define PROTOCOL_VERSION 0x161
+#define PROTOCOL_VERSION 0x162
 #define GET_PROTOCOL_MAJOR(x) ((x) & 0xff00)
 #define GET_PROTOCOL_MINOR(x) ((x) & 0x00ff)