guix/scripts/build.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (guix scripts build)
  21   #:use-module (guix ui)
  22   #:use-module (guix scripts)
  23   #:use-module (guix store)
  24   #:use-module (guix derivations)
  25   #:use-module (guix packages)
  26   #:use-module (guix utils)
  27   #:use-module (guix monads)
  28   #:use-module (guix gexp)
  29   #:autoload   (guix http-client) (http-fetch http-get-error?)
  30   #:use-module (ice-9 format)
  31   #:use-module (ice-9 match)
  32   #:use-module (ice-9 vlist)
  33   #:use-module (srfi srfi-1)
  34   #:use-module (srfi srfi-11)
  35   #:use-module (srfi srfi-26)
  36   #:use-module (srfi srfi-34)
  37   #:use-module (srfi srfi-37)
  38   #:autoload   (gnu packages) (specification->package %package-module-path)
  39   #:autoload   (guix download) (download-to-store)
  40   #:export (%standard-build-options
  41             set-build-options-from-command-line
  42             set-build-options-from-command-line*
  43             show-build-options-help
  44
  45             %transformation-options
  46             options->transformation
  47             show-transformation-options-help
  48
  49             guix-build))
  50
  51 (define %default-log-urls
  52   ;; Default base URLs for build logs.
  53   '("http://hydra.gnu.org/log"))
  54
  55 ;; XXX: The following procedure cannot be in (guix store) because of the
  56 ;; dependency on (guix derivations).
  57 (define* (log-url store file #:key (base-urls %default-log-urls))
  58   "Return a URL under one of the BASE-URLS where a build log for FILE can be
  59 found.  Return #f if no build log was found."
  60   (define (valid-url? url)
  61     ;; Probe URL and return #t if it is accessible.
  62     (guard (c ((http-get-error? c) #f))
  63       (close-port (http-fetch url #:buffered? #f))
  64       #t))
  65
  66   (define (find-url file)
  67     (let ((base (basename file)))
  68       (any (lambda (base-url)
  69              (let ((url (string-append base-url "/" base)))
  70                (and (valid-url? url) url)))
  71            base-urls)))
  72
  73   (cond ((derivation-path? file)
  74          (catch 'system-error
  75            (lambda ()
  76              ;; Usually we'll have more luck with the output file name since
  77              ;; the deriver that was used by the server could be different, so
  78              ;; try one of the output file names.
  79              (let ((drv (call-with-input-file file read-derivation)))
  80                (or (find-url (derivation->output-path drv))
  81                    (find-url file))))
  82            (lambda args
  83              ;; As a last resort, try the .drv.
  84              (if (= ENOENT (system-error-errno args))
  85                  (find-url file)
  86                  (apply throw args)))))
  87         (else
  88          (find-url file))))
  89
  90 (define (register-root store paths root)
  91   "Register ROOT as an indirect GC root for all of PATHS."
  92   (let* ((root (string-append (canonicalize-path (dirname root))
  93                               "/" root)))
  94     (catch 'system-error
  95       (lambda ()
  96         (match paths
  97           ((path)
  98            (symlink path root)
  99            (add-indirect-root store root))
 100           ((paths ...)
 101            (fold (lambda (path count)
 102                    (let ((root (string-append root
 103                                               "-"
 104                                               (number->string count))))
 105                      (symlink path root)
 106                      (add-indirect-root store root))
 107                    (+ 1 count))
 108                  0
 109                  paths))))
 110       (lambda args
 111         (leave (_ "failed to create GC root `~a': ~a~%")
 112                root (strerror (system-error-errno args)))))))
 113
 114 (define (package-with-source store p uri)
 115   "Return a package based on P but with its source taken from URI.  Extract
 116 the new package's version number from URI."
 117   (define (numeric-extension? file-name)
 118     ;; Return true if FILE-NAME ends with digits.
 119     (string-every char-set:hex-digit (file-extension file-name)))
 120
 121   (define (tarball-base-name file-name)
 122     ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar
 123     ;; extensions.
 124     ;; TODO: Factorize.
 125     (cond ((not (file-extension file-name))
 126            file-name)
 127           ((numeric-extension? file-name)
 128            file-name)
 129           ((string=? (file-extension file-name) "tar")
 130            (file-sans-extension file-name))
 131           ((file-extension file-name)
 132            (tarball-base-name (file-sans-extension file-name)))
 133           (else
 134            file-name)))
 135
 136   (let ((base (tarball-base-name (basename uri))))
 137     (let-values (((name version)
 138                   (package-name->name+version base)))
 139       (package (inherit p)
 140                (version (or version (package-version p)))
 141
 142                ;; Use #:recursive? #t to allow for directories.
 143                (source (download-to-store store uri
 144                                           #:recursive? #t))))))
 145
 146 \f
 147 ;;;
 148 ;;; Transformations.
 149 ;;;
 150
 151 (define (transform-package-source sources)
 152   "Return a transformation procedure that replaces package sources with the
 153 matching URIs given in SOURCES."
 154   (define new-sources
 155     (map (lambda (uri)
 156            (cons (package-name->name+version (basename uri))
 157                  uri))
 158          sources))
 159
 160   (lambda (store obj)
 161     (let loop ((sources  new-sources)
 162                (result   '()))
 163       (match obj
 164         ((? package? p)
 165          (let ((source (assoc-ref sources (package-name p))))
 166            (if source
 167                (package-with-source store p source)
 168                p)))
 169         (_
 170          obj)))))
 171
 172 (define (transform-package-inputs replacement-specs)
 173   "Return a procedure that, when passed a package, replaces its direct
 174 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
 175 strings like \"guile=guile@2.1\" meaning that, any direct dependency on a
 176 package called \"guile\" must be replaced with a dependency on a version 2.1
 177 of \"guile\"."
 178   (define not-equal
 179     (char-set-complement (char-set #\=)))
 180
 181   (define replacements
 182     ;; List of name/package pairs.
 183     (map (lambda (spec)
 184            (match (string-tokenize spec not-equal)
 185              ((old new)
 186               (cons old (specification->package new)))
 187              (_
 188               (leave (_ "invalid replacement specification: ~s~%") spec))))
 189          replacement-specs))
 190
 191   (define (rewrite input)
 192     (match input
 193       ((label (? package? package) outputs ...)
 194        (match (assoc-ref replacements (package-name package))
 195          (#f  (cons* label (replace package) outputs))
 196          (new (cons* label new outputs))))
 197       (_
 198        input)))
 199
 200   (define replace
 201     (memoize                                      ;XXX: use eq?
 202      (lambda (p)
 203        (package
 204          (inherit p)
 205          (inputs (map rewrite (package-inputs p)))
 206          (native-inputs (map rewrite (package-native-inputs p)))
 207          (propagated-inputs (map rewrite (package-propagated-inputs p)))))))
 208
 209   (lambda (store obj)
 210     (if (package? obj)
 211         (replace obj)
 212         obj)))
 213
 214 (define %transformations
 215   ;; Transformations that can be applied to things to build.  The car is the
 216   ;; key used in the option alist, and the cdr is the transformation
 217   ;; procedure; it is called with two arguments: the store, and a list of
 218   ;; things to build.
 219   `((with-source . ,transform-package-source)
 220     (with-input  . ,transform-package-inputs)))
 221
 222 (define %transformation-options
 223   ;; The command-line interface to the above transformations.
 224   (list (option '("with-source") #t #f
 225                 (lambda (opt name arg result . rest)
 226                   (apply values
 227                          (cons (alist-cons 'with-source arg result)
 228                                rest))))
 229         (option '("with-input") #t #f
 230                 (lambda (opt name arg result . rest)
 231                   (apply values
 232                          (cons (alist-cons 'with-input arg result)
 233                                rest))))))
 234
 235 (define (show-transformation-options-help)
 236   (display (_ "
 237       --with-source=SOURCE
 238                          use SOURCE when building the corresponding package"))
 239   (display (_ "
 240       --with-input=PACKAGE=REPLACEMENT
 241                          replace dependency PACKAGE by REPLACEMENT")))
 242
 243
 244 (define (options->transformation opts)
 245   "Return a procedure that, when passed an object to build (package,
 246 derivation, etc.), applies the transformations specified by OPTS."
 247   (define applicable
 248     ;; List of applicable transformations as symbol/procedure pairs.
 249     (filter-map (match-lambda
 250                   ((key . transform)
 251                    (match (filter-map (match-lambda
 252                                         ((k . arg)
 253                                          (and (eq? k key) arg)))
 254                                       opts)
 255                      (()   #f)
 256                      (args (cons key (transform args))))))
 257                 %transformations))
 258
 259   (lambda (store obj)
 260     (fold (match-lambda*
 261             (((name . transform) obj)
 262              (let ((new (transform store obj)))
 263                (when (eq? new obj)
 264                  (warning (_ "transformation '~a' had no effect on ~a~%")
 265                           name
 266                           (if (package? obj)
 267                               (package-full-name obj)
 268                               obj)))
 269                new)))
 270           obj
 271           applicable)))
 272
 273 \f
 274 ;;;
 275 ;;; Standard command-line build options.
 276 ;;;
 277
 278 (define (show-build-options-help)
 279   "Display on the current output port help about the standard command-line
 280 options handled by 'set-build-options-from-command-line', and listed in
 281 '%standard-build-options'."
 282   (display (_ "
 283   -L, --load-path=DIR    prepend DIR to the package module search path"))
 284   (display (_ "
 285   -K, --keep-failed      keep build tree of failed builds"))
 286   (display (_ "
 287   -k, --keep-going       keep going when some of the derivations fail"))
 288   (display (_ "
 289   -n, --dry-run          do not build the derivations"))
 290   (display (_ "
 291       --fallback         fall back to building when the substituter fails"))
 292   (display (_ "
 293       --no-substitutes   build instead of resorting to pre-built substitutes"))
 294   (display (_ "
 295       --substitute-urls=URLS
 296                          fetch substitute from URLS if they are authorized"))
 297   (display (_ "
 298       --no-build-hook    do not attempt to offload builds via the build hook"))
 299   (display (_ "
 300       --max-silent-time=SECONDS
 301                          mark the build as failed after SECONDS of silence"))
 302   (display (_ "
 303       --timeout=SECONDS  mark the build as failed after SECONDS of activity"))
 304   (display (_ "
 305       --verbosity=LEVEL  use the given verbosity LEVEL"))
 306   (display (_ "
 307       --rounds=N         build N times in a row to detect non-determinism"))
 308   (display (_ "
 309   -c, --cores=N          allow the use of up to N CPU cores for the build"))
 310   (display (_ "
 311   -M, --max-jobs=N       allow at most N build jobs")))
 312
 313 (define (set-build-options-from-command-line store opts)
 314   "Given OPTS, an alist as returned by 'args-fold' given
 315 '%standard-build-options', set the corresponding build options on STORE."
 316   ;; TODO: Add more options.
 317   (set-build-options store
 318                      #:keep-failed? (assoc-ref opts 'keep-failed?)
 319                      #:keep-going? (assoc-ref opts 'keep-going?)
 320                      #:rounds (assoc-ref opts 'rounds)
 321                      #:build-cores (or (assoc-ref opts 'cores) 0)
 322                      #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1)
 323                      #:fallback? (assoc-ref opts 'fallback?)
 324                      #:use-substitutes? (assoc-ref opts 'substitutes?)
 325                      #:substitute-urls (assoc-ref opts 'substitute-urls)
 326                      #:use-build-hook? (assoc-ref opts 'build-hook?)
 327                      #:max-silent-time (assoc-ref opts 'max-silent-time)
 328                      #:timeout (assoc-ref opts 'timeout)
 329                      #:print-build-trace (assoc-ref opts 'print-build-trace?)
 330                      #:verbosity (assoc-ref opts 'verbosity)))
 331
 332 (define set-build-options-from-command-line*
 333   (store-lift set-build-options-from-command-line))
 334
 335 (define %standard-build-options
 336   ;; List of standard command-line options for tools that build something.
 337   (list (option '(#\L "load-path") #t #f
 338                 (lambda (opt name arg result . rest)
 339                   ;; XXX: Imperatively modify the search paths.
 340                   (%package-module-path (cons arg (%package-module-path)))
 341                   (%patch-path (cons arg (%patch-path)))
 342                   (set! %load-path (cons arg %load-path))
 343                   (set! %load-compiled-path (cons arg %load-compiled-path))
 344
 345                   (apply values (cons result rest))))
 346         (option '(#\K "keep-failed") #f #f
 347                 (lambda (opt name arg result . rest)
 348                   (apply values
 349                          (alist-cons 'keep-failed? #t result)
 350                          rest)))
 351         (option '(#\k "keep-going") #f #f
 352                 (lambda (opt name arg result . rest)
 353                   (apply values
 354                          (alist-cons 'keep-going? #t result)
 355                          rest)))
 356         (option '("rounds") #t #f
 357                 (lambda (opt name arg result . rest)
 358                   (apply values
 359                          (alist-cons 'rounds (string->number* arg)
 360                                      result)
 361                          rest)))
 362         (option '("fallback") #f #f
 363                 (lambda (opt name arg result . rest)
 364                   (apply values
 365                          (alist-cons 'fallback? #t
 366                                      (alist-delete 'fallback? result))
 367                          rest)))
 368         (option '("no-substitutes") #f #f
 369                 (lambda (opt name arg result . rest)
 370                   (apply values
 371                          (alist-cons 'substitutes? #f
 372                                      (alist-delete 'substitutes? result))
 373                          rest)))
 374         (option '("substitute-urls") #t #f
 375                 (lambda (opt name arg result . rest)
 376                   (apply values
 377                          (alist-cons 'substitute-urls
 378                                      (string-tokenize arg)
 379                                      (alist-delete 'substitute-urls result))
 380                          rest)))
 381         (option '("no-build-hook") #f #f
 382                 (lambda (opt name arg result . rest)
 383                   (apply values
 384                          (alist-cons 'build-hook? #f
 385                                      (alist-delete 'build-hook? result))
 386                          rest)))
 387         (option '("max-silent-time") #t #f
 388                 (lambda (opt name arg result . rest)
 389                   (apply values
 390                          (alist-cons 'max-silent-time (string->number* arg)
 391                                      result)
 392                          rest)))
 393         (option '("timeout") #t #f
 394                 (lambda (opt name arg result . rest)
 395                   (apply values
 396                          (alist-cons 'timeout (string->number* arg) result)
 397                          rest)))
 398         (option '("verbosity") #t #f
 399                 (lambda (opt name arg result . rest)
 400                   (let ((level (string->number arg)))
 401                     (apply values
 402                            (alist-cons 'verbosity level
 403                                        (alist-delete 'verbosity result))
 404                            rest))))
 405         (option '(#\c "cores") #t #f
 406                 (lambda (opt name arg result . rest)
 407                   (let ((c (false-if-exception (string->number arg))))
 408                     (if c
 409                         (apply values (alist-cons 'cores c result) rest)
 410                         (leave (_ "not a number: '~a' option argument: ~a~%")
 411                                name arg)))))
 412         (option '(#\M "max-jobs") #t #f
 413                 (lambda (opt name arg result . rest)
 414                   (let ((c (false-if-exception (string->number arg))))
 415                     (if c
 416                         (apply values (alist-cons 'max-jobs c result) rest)
 417                         (leave (_ "not a number: '~a' option argument: ~a~%")
 418                                name arg)))))))
 419
 420 \f
 421 ;;;
 422 ;;; Command-line options.
 423 ;;;
 424
 425 (define %default-options
 426   ;; Alist of default option values.
 427   `((system . ,(%current-system))
 428     (build-mode . ,(build-mode normal))
 429     (graft? . #t)
 430     (substitutes? . #t)
 431     (build-hook? . #t)
 432     (print-build-trace? . #t)
 433     (max-silent-time . 3600)
 434     (verbosity . 0)))
 435
 436 (define (show-help)
 437   (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
 438 Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
 439   (display (_ "
 440   -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
 441   (display (_ "
 442   -f, --file=FILE        build the package or derivation that the code within
 443                          FILE evaluates to"))
 444   (display (_ "
 445   -S, --source           build the packages' source derivations"))
 446   (display (_ "
 447       --sources[=TYPE]   build source derivations; TYPE may optionally be one
 448                          of \"package\", \"all\" (default), or \"transitive\""))
 449   (display (_ "
 450   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
 451   (display (_ "
 452       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
 453   (display (_ "
 454       --no-grafts        do not graft packages"))
 455   (display (_ "
 456   -d, --derivations      return the derivation paths of the given packages"))
 457   (display (_ "
 458       --check            rebuild items to check for non-determinism issues"))
 459   (display (_ "
 460   -r, --root=FILE        make FILE a symlink to the result, and register it
 461                          as a garbage collector root"))
 462   (display (_ "
 463       --log-file         return the log file names for the given derivations"))
 464   (newline)
 465   (show-build-options-help)
 466   (newline)
 467   (show-transformation-options-help)
 468   (newline)
 469   (display (_ "
 470   -h, --help             display this help and exit"))
 471   (display (_ "
 472   -V, --version          display version information and exit"))
 473   (newline)
 474   (show-bug-report-information))
 475
 476 (define %options
 477   ;; Specifications of the command-line options.
 478   (cons* (option '(#\h "help") #f #f
 479                  (lambda args
 480                    (show-help)
 481                    (exit 0)))
 482          (option '(#\V "version") #f #f
 483                  (lambda args
 484                    (show-version-and-exit "guix build")))
 485          (option '(#\S "source") #f #f
 486                  (lambda (opt name arg result)
 487                    (alist-cons 'source #t result)))
 488          (option '("sources") #f #t
 489                  (lambda (opt name arg result)
 490                    (match arg
 491                      ("package"
 492                       (alist-cons 'source #t result))
 493                      ((or "all" #f)
 494                       (alist-cons 'source package-direct-sources result))
 495                      ("transitive"
 496                       (alist-cons 'source package-transitive-sources result))
 497                      (else
 498                       (leave (_ "invalid argument: '~a' option argument: ~a, ~
 499 must be one of 'package', 'all', or 'transitive'~%")
 500                              name arg)))))
 501          (option '("check") #f #f
 502                  (lambda (opt name arg result . rest)
 503                    (apply values
 504                           (alist-cons 'build-mode (build-mode check)
 505                                       result)
 506                           rest)))
 507          (option '(#\s "system") #t #f
 508                  (lambda (opt name arg result)
 509                    (alist-cons 'system arg
 510                                (alist-delete 'system result eq?))))
 511          (option '("target") #t #f
 512                  (lambda (opt name arg result)
 513                    (alist-cons 'target arg
 514                                (alist-delete 'target result eq?))))
 515          (option '(#\d "derivations") #f #f
 516                  (lambda (opt name arg result)
 517                    (alist-cons 'derivations-only? #t result)))
 518          (option '(#\e "expression") #t #f
 519                  (lambda (opt name arg result)
 520                    (alist-cons 'expression arg result)))
 521          (option '(#\f "file") #t #f
 522                  (lambda (opt name arg result)
 523                    (alist-cons 'file arg result)))
 524          (option '(#\n "dry-run") #f #f
 525                  (lambda (opt name arg result)
 526                    (alist-cons 'dry-run? #t result)))
 527          (option '(#\r "root") #t #f
 528                  (lambda (opt name arg result)
 529                    (alist-cons 'gc-root arg result)))
 530          (option '("log-file") #f #f
 531                  (lambda (opt name arg result)
 532                    (alist-cons 'log-file? #t result)))
 533          (option '("no-grafts") #f #f
 534                  (lambda (opt name arg result)
 535                    (alist-cons 'graft? #f
 536                                (alist-delete 'graft? result eq?))))
 537
 538          (append %transformation-options
 539                  %standard-build-options)))
 540
 541 (define (options->things-to-build opts)
 542   "Read the arguments from OPTS and return a list of high-level objects to
 543 build---packages, gexps, derivations, and so on."
 544   (define (validate-type x)
 545     (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x))
 546       (leave (_ "~s: not something we can build~%") x)))
 547
 548   (define (ensure-list x)
 549     (let ((lst (match x
 550                  ((x ...) x)
 551                  (x       (list x)))))
 552       (for-each validate-type lst)
 553       lst))
 554
 555   (append-map (match-lambda
 556                 (('argument . (? string? spec))
 557                  (cond ((derivation-path? spec)
 558                         (list (call-with-input-file spec read-derivation)))
 559                        ((store-path? spec)
 560                         ;; Nothing to do; maybe for --log-file.
 561                         '())
 562                        (else
 563                         (list (specification->package spec)))))
 564                 (('file . file)
 565                  (ensure-list (load* file (make-user-module '()))))
 566                 (('expression . str)
 567                  (ensure-list (read/eval str)))
 568                 (('argument . (? derivation? drv))
 569                  drv)
 570                 (_ '()))
 571               opts))
 572
 573 (define (options->derivations store opts)
 574   "Given OPTS, the result of 'args-fold', return a list of derivations to
 575 build."
 576   (define transform
 577     (options->transformation opts))
 578
 579   (define package->derivation
 580     (match (assoc-ref opts 'target)
 581       (#f package-derivation)
 582       (triplet
 583        (cut package-cross-derivation <> <> triplet <>))))
 584
 585   (define src    (assoc-ref opts 'source))
 586   (define system (assoc-ref opts 'system))
 587   (define graft? (assoc-ref opts 'graft?))
 588
 589   (parameterize ((%graft? graft?))
 590     (append-map (match-lambda
 591                   ((? package? p)
 592                    (match src
 593                      (#f
 594                       (list (package->derivation store p system)))
 595                      (#t
 596                       (let ((s (package-source p)))
 597                         (list (package-source-derivation store s))))
 598                      (proc
 599                       (map (cut package-source-derivation store <>)
 600                            (proc p)))))
 601                   ((? derivation? drv)
 602                    (list drv))
 603                   ((? procedure? proc)
 604                    (list (run-with-store store
 605                            (mbegin %store-monad
 606                              (set-guile-for-build (default-guile))
 607                              (proc))
 608                            #:system system)))
 609                   ((? gexp? gexp)
 610                    (list (run-with-store store
 611                            (mbegin %store-monad
 612                              (set-guile-for-build (default-guile))
 613                              (gexp->derivation "gexp" gexp
 614                                                #:system system))))))
 615                 (map (cut transform store <>)
 616                      (options->things-to-build opts)))))
 617
 618 (define (show-build-log store file urls)
 619   "Show the build log for FILE, falling back to remote logs from URLS if
 620 needed."
 621   (let ((log (or (log-file store file)
 622                  (log-url store file #:base-urls urls))))
 623     (if log
 624         (format #t "~a~%" log)
 625         (leave (_ "no build log for '~a'~%") file))))
 626
 627 \f
 628 ;;;
 629 ;;; Entry point.
 630 ;;;
 631
 632 (define (guix-build . args)
 633   (with-error-handling
 634     ;; Ask for absolute file names so that .drv file names passed from the
 635     ;; user to 'read-derivation' are absolute when it returns.
 636     (with-fluids ((%file-port-name-canonicalization 'absolute))
 637       (let* ((opts  (parse-command-line args %options
 638                                         (list %default-options)))
 639              (store (open-connection))
 640              (mode  (assoc-ref opts 'build-mode))
 641              (drv   (options->derivations store opts))
 642              (urls  (map (cut string-append <> "/log")
 643                          (if (assoc-ref opts 'substitutes?)
 644                              (or (assoc-ref opts 'substitute-urls)
 645                                  ;; XXX: This does not necessarily match the
 646                                  ;; daemon's substitute URLs.
 647                                  %default-substitute-urls)
 648                              '())))
 649              (items (filter-map (match-lambda
 650                                   (('argument . (? store-path? file))
 651                                    file)
 652                                   (_ #f))
 653                                 opts))
 654              (roots (filter-map (match-lambda
 655                                   (('gc-root . root) root)
 656                                   (_ #f))
 657                                 opts)))
 658
 659         (set-build-options-from-command-line store opts)
 660         (unless (assoc-ref opts 'log-file?)
 661           (show-what-to-build store drv
 662                               #:use-substitutes? (assoc-ref opts 'substitutes?)
 663                               #:dry-run? (assoc-ref opts 'dry-run?)
 664                               #:mode mode))
 665
 666         (cond ((assoc-ref opts 'log-file?)
 667                (for-each (cut show-build-log store <> urls)
 668                          (delete-duplicates
 669                           (append (map derivation-file-name drv)
 670                                   items))))
 671               ((assoc-ref opts 'derivations-only?)
 672                (format #t "~{~a~%~}" (map derivation-file-name drv))
 673                (for-each (cut register-root store <> <>)
 674                          (map (compose list derivation-file-name) drv)
 675                          roots))
 676               ((not (assoc-ref opts 'dry-run?))
 677                (and (build-derivations store drv mode)
 678                     (for-each show-derivation-outputs drv)
 679                     (for-each (cut register-root store <> <>)
 680                               (map (lambda (drv)
 681                                      (map cdr
 682                                           (derivation->output-paths drv)))
 683                                    drv)
 684                               roots))))))))