summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-18 22:46:39 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-22 12:42:51 +0100
commit62195b9a8fd6846117c5d7698842748300d13e31 (patch)
tree106c4d67eb1c6ba355203e1a4a52b38669b83bd5
parent07ce23e011d18460e7ff5553d4ff640f7073075b (diff)
downloadguix-62195b9a8fd6846117c5d7698842748300d13e31.tar.gz
guix build: Use 'with-build-handler'.
Fixes <https://bugs.gnu.org/28310>.
Reported by Andreas Enge <andreas@enge.fr>.

* guix/scripts/build.scm (guix-build): Wrap 'parameterize' in
'with-build-handler'.  Remove explicit call to 'show-what-to-build'.
Call 'build-derivations' regardless of whether OPTS contains 'dry-run?'.
-rw-r--r--guix/scripts/build.scm118
1 files changed, 57 insertions, 61 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index da2a675ce2..af18d8b6f9 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -952,64 +952,60 @@ needed."
         ;; Set the build options before we do anything else.
         (set-build-options-from-command-line store opts)
 
-        (parameterize ((current-terminal-columns (terminal-columns))
-
-                       ;; Set grafting upfront in case the user's input
-                       ;; depends on it (e.g., a manifest or code snippet that
-                       ;; calls 'gexp->derivation').
-                       (%graft?                  graft?))
-          (let* ((mode  (assoc-ref opts 'build-mode))
-                 (drv   (options->derivations store opts))
-                 (urls  (map (cut string-append <> "/log")
-                             (if (assoc-ref opts 'substitutes?)
-                                 (or (assoc-ref opts 'substitute-urls)
-                                     ;; XXX: This does not necessarily match the
-                                     ;; daemon's substitute URLs.
-                                     %default-substitute-urls)
-                                 '())))
-                 (items (filter-map (match-lambda
-                                      (('argument . (? store-path? file))
-                                       ;; If FILE is a .drv that's not in
-                                       ;; store, keep it so that it can be
-                                       ;; substituted.
-                                       (and (or (not (derivation-path? file))
-                                                (not (file-exists? file)))
-                                            file))
-                                      (_ #f))
-                                    opts))
-                 (roots (filter-map (match-lambda
-                                      (('gc-root . root) root)
-                                      (_ #f))
-                                    opts)))
-
-            (unless (or (assoc-ref opts 'log-file?)
-                        (assoc-ref opts 'derivations-only?))
-              (show-what-to-build store drv
-                                  #:use-substitutes?
-                                  (assoc-ref opts 'substitutes?)
-                                  #:dry-run? (assoc-ref opts 'dry-run?)
-                                  #:mode mode))
-
-            (cond ((assoc-ref opts 'log-file?)
-                   ;; Pass 'show-build-log' the output file names, not the
-                   ;; derivation file names, because there can be several
-                   ;; derivations leading to the same output.
-                   (for-each (cut show-build-log store <> urls)
-                             (delete-duplicates
-                              (append (map derivation->output-path drv)
-                                      items))))
-                  ((assoc-ref opts 'derivations-only?)
-                   (format #t "~{~a~%~}" (map derivation-file-name drv))
-                   (for-each (cut register-root store <> <>)
-                             (map (compose list derivation-file-name) drv)
-                             roots))
-                  ((not (assoc-ref opts 'dry-run?))
-                   (and (build-derivations store (append drv items)
-                                           mode)
-                        (for-each show-derivation-outputs drv)
-                        (for-each (cut register-root store <> <>)
-                                  (map (lambda (drv)
-                                         (map cdr
-                                              (derivation->output-paths drv)))
-                                       drv)
-                                  roots))))))))))
+        (with-build-handler (build-notifier #:use-substitutes?
+                                            (assoc-ref opts 'substitutes?)
+                                            #:dry-run?
+                                            (assoc-ref opts 'dry-run?))
+          (parameterize ((current-terminal-columns (terminal-columns))
+
+                         ;; Set grafting upfront in case the user's input
+                         ;; depends on it (e.g., a manifest or code snippet that
+                         ;; calls 'gexp->derivation').
+                         (%graft?                  graft?))
+            (let* ((mode  (assoc-ref opts 'build-mode))
+                   (drv   (options->derivations store opts))
+                   (urls  (map (cut string-append <> "/log")
+                               (if (assoc-ref opts 'substitutes?)
+                                   (or (assoc-ref opts 'substitute-urls)
+                                       ;; XXX: This does not necessarily match the
+                                       ;; daemon's substitute URLs.
+                                       %default-substitute-urls)
+                                   '())))
+                   (items (filter-map (match-lambda
+                                        (('argument . (? store-path? file))
+                                         ;; If FILE is a .drv that's not in
+                                         ;; store, keep it so that it can be
+                                         ;; substituted.
+                                         (and (or (not (derivation-path? file))
+                                                  (not (file-exists? file)))
+                                              file))
+                                        (_ #f))
+                                      opts))
+                   (roots (filter-map (match-lambda
+                                        (('gc-root . root) root)
+                                        (_ #f))
+                                      opts)))
+
+              (cond ((assoc-ref opts 'log-file?)
+                     ;; Pass 'show-build-log' the output file names, not the
+                     ;; derivation file names, because there can be several
+                     ;; derivations leading to the same output.
+                     (for-each (cut show-build-log store <> urls)
+                               (delete-duplicates
+                                (append (map derivation->output-path drv)
+                                        items))))
+                    ((assoc-ref opts 'derivations-only?)
+                     (format #t "~{~a~%~}" (map derivation-file-name drv))
+                     (for-each (cut register-root store <> <>)
+                               (map (compose list derivation-file-name) drv)
+                               roots))
+                    (else
+                     (and (build-derivations store (append drv items)
+                                             mode)
+                          (for-each show-derivation-outputs drv)
+                          (for-each (cut register-root store <> <>)
+                                    (map (lambda (drv)
+                                           (map cdr
+                                                (derivation->output-paths drv)))
+                                         drv)
+                                    roots)))))))))))