From c8f9f24776040cc5645cf3b91b19946b1f1e4dac Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 4 Mar 2016 17:50:30 +0100
Subject: guix build: Set the build options early.

This fixes a bug whereby, with grafts leading to builds very early,
build options such as --substitute-urls would not be taken into account
yet.

Reported by Andreas Enge <andreas@enge.fr>.

* guix/scripts/build.scm (guix-build): Move 'opts' to the beginning.
Use 'with-store' instead of 'open-connection'.  Call
'set-build-options-from-command-line' right after 'with-store'.
---
 guix/scripts/build.scm | 98 ++++++++++++++++++++++++++------------------------
 1 file changed, 51 insertions(+), 47 deletions(-)

(limited to 'guix/scripts/build.scm')

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index a8becea2de..3607d78537 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -634,55 +634,59 @@ needed."
 ;;;
 
 (define (guix-build . args)
+  (define opts
+    (parse-command-line args %options
+                        (list %default-options)))
+
   (with-error-handling
     ;; Ask for absolute file names so that .drv file names passed from the
     ;; user to 'read-derivation' are absolute when it returns.
     (with-fluids ((%file-port-name-canonicalization 'absolute))
-      (let* ((opts  (parse-command-line args %options
-                                        (list %default-options)))
-             (store (open-connection))
-             (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))
-                                   file)
-                                  (_ #f))
-                                opts))
-             (roots (filter-map (match-lambda
-                                  (('gc-root . root) root)
-                                  (_ #f))
-                                opts)))
-
+      (with-store store
+        ;; Set the build options before we do anything else.
         (set-build-options-from-command-line store opts)
-        (unless (assoc-ref opts 'log-file?)
-          (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?)
-               (for-each (cut show-build-log store <> urls)
-                         (delete-duplicates
-                          (append (map derivation-file-name 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 drv mode)
-                    (for-each show-derivation-outputs drv)
-                    (for-each (cut register-root store <> <>)
-                              (map (lambda (drv)
-                                     (map cdr
-                                          (derivation->output-paths drv)))
-                                   drv)
-                              roots))))))))
+
+        (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))
+                                     file)
+                                    (_ #f))
+                                  opts))
+               (roots (filter-map (match-lambda
+                                    (('gc-root . root) root)
+                                    (_ #f))
+                                  opts)))
+
+          (unless (assoc-ref opts 'log-file?)
+            (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?)
+                 (for-each (cut show-build-log store <> urls)
+                           (delete-duplicates
+                            (append (map derivation-file-name 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 drv mode)
+                      (for-each show-derivation-outputs drv)
+                      (for-each (cut register-root store <> <>)
+                                (map (lambda (drv)
+                                       (map cdr
+                                            (derivation->output-paths drv)))
+                                     drv)
+                                roots)))))))))
-- 
cgit v1.2.3