Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
6a7c4636 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
dc5669cd | 3 | ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> |
11415d35 | 4 | ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com> |
f87e5632 | 5 | ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> |
14a1c319 | 6 | ;;; |
233e7676 | 7 | ;;; This file is part of GNU Guix. |
14a1c319 | 8 | ;;; |
233e7676 | 9 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
14a1c319 LC |
10 | ;;; under the terms of the GNU General Public License as published by |
11 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
12 | ;;; your option) any later version. | |
13 | ;;; | |
233e7676 | 14 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
14a1c319 LC |
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;;; GNU General Public License for more details. | |
18 | ;;; | |
19 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
14a1c319 | 21 | |
e49951eb | 22 | (define-module (guix scripts build) |
073c34d7 | 23 | #:use-module (guix ui) |
88981dd3 | 24 | #:use-module (guix scripts) |
f87e5632 | 25 | #:use-module (guix import json) |
14a1c319 LC |
26 | #:use-module (guix store) |
27 | #:use-module (guix derivations) | |
28 | #:use-module (guix packages) | |
7adf9b84 | 29 | #:use-module (guix grafts) |
9a2a2005 | 30 | |
3e30cdf1 LC |
31 | #:use-module (guix utils) |
32 | ||
9a2a2005 | 33 | ;; Use the procedure that destructures "NAME-VERSION" forms. |
3e30cdf1 LC |
34 | #:use-module ((guix build utils) |
35 | #:select ((package-name->name+version | |
36 | . hyphen-package-name->name+version))) | |
9a2a2005 | 37 | |
ac5de156 | 38 | #:use-module (guix monads) |
56b82106 | 39 | #:use-module (guix gexp) |
11415d35 | 40 | #:use-module (guix profiles) |
3f208ad7 | 41 | #:autoload (guix http-client) (http-fetch http-get-error?) |
14a1c319 LC |
42 | #:use-module (ice-9 format) |
43 | #:use-module (ice-9 match) | |
dc5669cd | 44 | #:use-module (ice-9 vlist) |
14a1c319 | 45 | #:use-module (srfi srfi-1) |
5401dd75 | 46 | #:use-module (srfi srfi-11) |
14a1c319 | 47 | #:use-module (srfi srfi-26) |
07783858 | 48 | #:use-module (srfi srfi-34) |
14a1c319 | 49 | #:use-module (srfi srfi-37) |
7a0836cf | 50 | #:use-module (gnu packages) |
7f3673f2 | 51 | #:autoload (guix download) (download-to-store) |
6a7c4636 | 52 | #:autoload (guix git-download) (git-reference? git-reference-url) |
7a0836cf | 53 | #:autoload (guix git) (git-checkout git-checkout? git-checkout-url) |
2637cfd7 | 54 | #:use-module ((guix status) #:select (with-status-verbosity)) |
dc0f74e5 LC |
55 | #:use-module ((guix progress) #:select (current-terminal-columns)) |
56 | #:use-module ((guix build syscalls) #:select (terminal-columns)) | |
257b9341 | 57 | #:export (%standard-build-options |
e7fc17b5 | 58 | set-build-options-from-command-line |
2d977638 | 59 | set-build-options-from-command-line* |
e7fc17b5 | 60 | show-build-options-help |
88ad6ded LC |
61 | |
62 | %transformation-options | |
629a064f | 63 | options->transformation |
88ad6ded | 64 | show-transformation-options-help |
e7fc17b5 | 65 | |
1c6b2d3f | 66 | guix-build |
a09b45da CM |
67 | register-root |
68 | register-root*)) | |
14a1c319 | 69 | |
3f208ad7 LC |
70 | (define %default-log-urls |
71 | ;; Default base URLs for build logs. | |
757e633d | 72 | '("http://ci.guix.gnu.org/log")) |
3f208ad7 LC |
73 | |
74 | ;; XXX: The following procedure cannot be in (guix store) because of the | |
75 | ;; dependency on (guix derivations). | |
76 | (define* (log-url store file #:key (base-urls %default-log-urls)) | |
77 | "Return a URL under one of the BASE-URLS where a build log for FILE can be | |
78 | found. Return #f if no build log was found." | |
79 | (define (valid-url? url) | |
80 | ;; Probe URL and return #t if it is accessible. | |
7d85fcde | 81 | (catch #t |
c22a4757 LC |
82 | (lambda () |
83 | (guard (c ((http-get-error? c) #f)) | |
84 | (close-port (http-fetch url #:buffered? #f)) | |
85 | #t)) | |
7d85fcde LC |
86 | (match-lambda* |
87 | (('getaddrinfo-error . _) | |
88 | #f) | |
89 | (('tls-certificate-error args ...) | |
90 | (report-error (G_ "cannot access build log at '~a':~%") url) | |
91 | (print-exception (current-error-port) #f | |
92 | 'tls-certificate-error args) | |
93 | (exit 1)) | |
94 | ((key . args) | |
95 | (apply throw key args))))) | |
3f208ad7 LC |
96 | |
97 | (define (find-url file) | |
98 | (let ((base (basename file))) | |
99 | (any (lambda (base-url) | |
100 | (let ((url (string-append base-url "/" base))) | |
101 | (and (valid-url? url) url))) | |
102 | base-urls))) | |
103 | ||
104 | (cond ((derivation-path? file) | |
105 | (catch 'system-error | |
106 | (lambda () | |
107 | ;; Usually we'll have more luck with the output file name since | |
108 | ;; the deriver that was used by the server could be different, so | |
109 | ;; try one of the output file names. | |
015f17e8 | 110 | (let ((drv (read-derivation-from-file file))) |
3f208ad7 LC |
111 | (or (find-url (derivation->output-path drv)) |
112 | (find-url file)))) | |
113 | (lambda args | |
114 | ;; As a last resort, try the .drv. | |
115 | (if (= ENOENT (system-error-errno args)) | |
116 | (find-url file) | |
117 | (apply throw args))))) | |
118 | (else | |
119 | (find-url file)))) | |
120 | ||
81fa80b2 LC |
121 | (define (register-root store paths root) |
122 | "Register ROOT as an indirect GC root for all of PATHS." | |
840f38ba LC |
123 | (let* ((root (if (string-prefix? "/" root) |
124 | root | |
125 | (string-append (canonicalize-path (dirname root)) | |
4aea820f | 126 | "/" (basename root))))) |
81fa80b2 LC |
127 | (catch 'system-error |
128 | (lambda () | |
129 | (match paths | |
130 | ((path) | |
131 | (symlink path root) | |
132 | (add-indirect-root store root)) | |
133 | ((paths ...) | |
134 | (fold (lambda (path count) | |
135 | (let ((root (string-append root | |
136 | "-" | |
137 | (number->string count)))) | |
138 | (symlink path root) | |
139 | (add-indirect-root store root)) | |
140 | (+ 1 count)) | |
141 | 0 | |
142 | paths)))) | |
143 | (lambda args | |
69daee23 | 144 | (leave (G_ "failed to create GC root `~a': ~a~%") |
81fa80b2 LC |
145 | root (strerror (system-error-errno args))))))) |
146 | ||
a09b45da CM |
147 | (define register-root* |
148 | (store-lift register-root)) | |
149 | ||
3e30cdf1 LC |
150 | (define (numeric-extension? file-name) |
151 | "Return true if FILE-NAME ends with digits." | |
152 | (string-every char-set:hex-digit (file-extension file-name))) | |
153 | ||
154 | (define (tarball-base-name file-name) | |
155 | "Return the \"base\" of FILE-NAME, removing '.tar.gz' or similar | |
156 | extensions." | |
157 | ;; TODO: Factorize. | |
158 | (cond ((not (file-extension file-name)) | |
159 | file-name) | |
160 | ((numeric-extension? file-name) | |
161 | file-name) | |
162 | ((string=? (file-extension file-name) "tar") | |
163 | (file-sans-extension file-name)) | |
164 | ((file-extension file-name) | |
165 | => | |
166 | (match-lambda | |
167 | ("scm" file-name) | |
168 | (else (tarball-base-name (file-sans-extension file-name))))) | |
169 | (else | |
170 | file-name))) | |
171 | ||
172 | (define* (package-with-source store p uri #:optional version) | |
7f3673f2 LC |
173 | "Return a package based on P but with its source taken from URI. Extract |
174 | the new package's version number from URI." | |
7f3673f2 | 175 | (let ((base (tarball-base-name (basename uri)))) |
3e30cdf1 LC |
176 | (let-values (((_ version*) |
177 | (hyphen-package-name->name+version base))) | |
7f3673f2 | 178 | (package (inherit p) |
3e30cdf1 LC |
179 | (version (or version version* |
180 | (package-version p))) | |
a43b55f1 LC |
181 | |
182 | ;; Use #:recursive? #t to allow for directories. | |
183 | (source (download-to-store store uri | |
7c247809 LC |
184 | #:recursive? #t)) |
185 | ||
186 | ;; Override the replacement, otherwise '--with-source' would | |
187 | ;; have no effect. | |
188 | (replacement #f))))) | |
7f3673f2 | 189 | |
14a1c319 | 190 | \f |
88ad6ded LC |
191 | ;;; |
192 | ;;; Transformations. | |
193 | ;;; | |
194 | ||
195 | (define (transform-package-source sources) | |
196 | "Return a transformation procedure that replaces package sources with the | |
197 | matching URIs given in SOURCES." | |
198 | (define new-sources | |
199 | (map (lambda (uri) | |
3e30cdf1 LC |
200 | (match (string-index uri #\=) |
201 | (#f | |
202 | ;; Determine the package name and version from URI. | |
203 | (call-with-values | |
204 | (lambda () | |
205 | (hyphen-package-name->name+version | |
206 | (tarball-base-name (basename uri)))) | |
207 | (lambda (name version) | |
208 | (list name version uri)))) | |
209 | (index | |
210 | ;; What's before INDEX is a "PKG@VER" or "PKG" spec. | |
211 | (call-with-values | |
212 | (lambda () | |
213 | (package-name->name+version (string-take uri index))) | |
214 | (lambda (name version) | |
215 | (list name version | |
216 | (string-drop uri (+ 1 index)))))))) | |
88ad6ded LC |
217 | sources)) |
218 | ||
219 | (lambda (store obj) | |
220 | (let loop ((sources new-sources) | |
221 | (result '())) | |
222 | (match obj | |
223 | ((? package? p) | |
3e30cdf1 LC |
224 | (match (assoc-ref sources (package-name p)) |
225 | ((version source) | |
226 | (package-with-source store p source version)) | |
227 | (#f | |
228 | p))) | |
88ad6ded LC |
229 | (_ |
230 | obj))))) | |
231 | ||
5cf01aa5 | 232 | (define (evaluate-replacement-specs specs proc) |
14328b81 LC |
233 | "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list |
234 | of package spec/procedure pairs as expected by 'package-input-rewriting/spec'. | |
235 | PROC is called with the package to be replaced and its replacement according | |
236 | to SPECS. Raise an error if an element of SPECS uses invalid syntax, or if a | |
237 | package it refers to could not be found." | |
47c0f92c LC |
238 | (define not-equal |
239 | (char-set-complement (char-set #\=))) | |
240 | ||
5cf01aa5 LC |
241 | (map (lambda (spec) |
242 | (match (string-tokenize spec not-equal) | |
14328b81 LC |
243 | ((spec new) |
244 | (cons spec | |
245 | (let ((new (specification->package new))) | |
246 | (lambda (old) | |
247 | (proc old new))))) | |
5cf01aa5 | 248 | (x |
69daee23 | 249 | (leave (G_ "invalid replacement specification: ~s~%") spec)))) |
5cf01aa5 LC |
250 | specs)) |
251 | ||
252 | (define (transform-package-inputs replacement-specs) | |
253 | "Return a procedure that, when passed a package, replaces its direct | |
254 | dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of | |
255 | strings like \"guile=guile@2.1\" meaning that, any dependency on a package | |
256 | called \"guile\" must be replaced with a dependency on a version 2.1 of | |
257 | \"guile\"." | |
14328b81 LC |
258 | (let* ((replacements (evaluate-replacement-specs replacement-specs |
259 | (lambda (old new) | |
260 | new))) | |
261 | (rewrite (package-input-rewriting/spec replacements))) | |
4e49163f LC |
262 | (lambda (store obj) |
263 | (if (package? obj) | |
264 | (rewrite obj) | |
265 | obj)))) | |
47c0f92c | 266 | |
645b9df8 LC |
267 | (define (transform-package-inputs/graft replacement-specs) |
268 | "Return a procedure that, when passed a package, replaces its direct | |
269 | dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of | |
270 | strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the | |
271 | current 'gnutls' package, after which version 3.5.4 is grafted onto them." | |
14328b81 LC |
272 | (define (set-replacement old new) |
273 | (package (inherit old) (replacement new))) | |
645b9df8 LC |
274 | |
275 | (let* ((replacements (evaluate-replacement-specs replacement-specs | |
14328b81 LC |
276 | set-replacement)) |
277 | (rewrite (package-input-rewriting/spec replacements))) | |
645b9df8 LC |
278 | (lambda (store obj) |
279 | (if (package? obj) | |
280 | (rewrite obj) | |
281 | obj)))) | |
282 | ||
880916ac LC |
283 | (define %not-equal |
284 | (char-set-complement (char-set #\=))) | |
285 | ||
0c0ff42a LC |
286 | (define (package-git-url package) |
287 | "Return the URL of the Git repository for package, or raise an error if | |
288 | the source of PACKAGE is not fetched from a Git repository." | |
289 | (let ((source (package-source package))) | |
290 | (cond ((and (origin? source) | |
291 | (git-reference? (origin-uri source))) | |
292 | (git-reference-url (origin-uri source))) | |
293 | ((git-checkout? source) | |
294 | (git-checkout-url source)) | |
295 | (else | |
296 | (leave (G_ "the source of ~a is not a Git reference~%") | |
297 | (package-full-name package)))))) | |
298 | ||
b18f7234 | 299 | (define (evaluate-git-replacement-specs specs proc) |
96915a44 | 300 | "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list |
b18f7234 LC |
301 | of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the |
302 | replacement package. Raise an error if an element of SPECS uses invalid | |
303 | syntax, or if a package it refers to could not be found." | |
96915a44 | 304 | (map (lambda (spec) |
880916ac | 305 | (match (string-tokenize spec %not-equal) |
14328b81 LC |
306 | ((spec branch-or-commit) |
307 | (define (replace old) | |
308 | (let* ((source (package-source old)) | |
309 | (url (package-git-url old))) | |
310 | (proc old url branch-or-commit))) | |
311 | ||
312 | (cons spec replace)) | |
96915a44 LC |
313 | (x |
314 | (leave (G_ "invalid replacement specification: ~s~%") spec)))) | |
315 | specs)) | |
316 | ||
317 | (define (transform-package-source-branch replacement-specs) | |
318 | "Return a procedure that, when passed a package, replaces its direct | |
319 | dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of | |
320 | strings like \"guile-next=stable-3.0\" meaning that packages are built using | |
321 | 'guile-next' from the latest commit on its 'stable-3.0' branch." | |
b18f7234 LC |
322 | (define (replace old url branch) |
323 | (package | |
324 | (inherit old) | |
d831b190 LC |
325 | (version (string-append "git." (string-map (match-lambda |
326 | (#\/ #\-) | |
327 | (chr chr)) | |
328 | branch))) | |
024a6bfb LC |
329 | (source (git-checkout (url url) (branch branch) |
330 | (recursive? #t))))) | |
b18f7234 LC |
331 | |
332 | (let* ((replacements (evaluate-git-replacement-specs replacement-specs | |
333 | replace)) | |
14328b81 | 334 | (rewrite (package-input-rewriting/spec replacements))) |
b18f7234 LC |
335 | (lambda (store obj) |
336 | (if (package? obj) | |
337 | (rewrite obj) | |
338 | obj)))) | |
339 | ||
340 | (define (transform-package-source-commit replacement-specs) | |
341 | "Return a procedure that, when passed a package, replaces its direct | |
342 | dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of | |
343 | strings like \"guile-next=cabba9e\" meaning that packages are built using | |
344 | 'guile-next' from commit 'cabba9e'." | |
345 | (define (replace old url commit) | |
346 | (package | |
347 | (inherit old) | |
4d04bc50 LC |
348 | (version (if (and (> (string-length commit) 1) |
349 | (string-prefix? "v" commit) | |
350 | (char-set-contains? char-set:digit | |
351 | (string-ref commit 1))) | |
352 | (string-drop commit 1) ;looks like a tag like "v1.0" | |
353 | (string-append "git." | |
354 | (if (< (string-length commit) 7) | |
355 | commit | |
356 | (string-take commit 7))))) | |
845c4401 LC |
357 | (source (git-checkout (url url) (commit commit) |
358 | (recursive? #t))))) | |
b18f7234 LC |
359 | |
360 | (let* ((replacements (evaluate-git-replacement-specs replacement-specs | |
361 | replace)) | |
14328b81 | 362 | (rewrite (package-input-rewriting/spec replacements))) |
96915a44 LC |
363 | (lambda (store obj) |
364 | (if (package? obj) | |
365 | (rewrite obj) | |
366 | obj)))) | |
367 | ||
880916ac LC |
368 | (define (transform-package-source-git-url replacement-specs) |
369 | "Return a procedure that, when passed a package, replaces its dependencies | |
370 | according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of strings like | |
371 | \"guile-json=https://gitthing.com/…\" meaning that packages are built using | |
372 | a checkout of the Git repository at the given URL." | |
880916ac LC |
373 | (define replacements |
374 | (map (lambda (spec) | |
375 | (match (string-tokenize spec %not-equal) | |
14328b81 LC |
376 | ((spec url) |
377 | (cons spec | |
378 | (lambda (old) | |
379 | (package | |
380 | (inherit old) | |
381 | (source (git-checkout (url url) | |
45d41c03 LC |
382 | (recursive? #t))))))) |
383 | (_ | |
384 | (leave (G_ "~a: invalid Git URL replacement specification~%") | |
385 | spec)))) | |
880916ac LC |
386 | replacement-specs)) |
387 | ||
388 | (define rewrite | |
14328b81 | 389 | (package-input-rewriting/spec replacements)) |
880916ac LC |
390 | |
391 | (lambda (store obj) | |
392 | (if (package? obj) | |
393 | (rewrite obj) | |
394 | obj))) | |
395 | ||
88ad6ded LC |
396 | (define %transformations |
397 | ;; Transformations that can be applied to things to build. The car is the | |
398 | ;; key used in the option alist, and the cdr is the transformation | |
399 | ;; procedure; it is called with two arguments: the store, and a list of | |
400 | ;; things to build. | |
47c0f92c | 401 | `((with-source . ,transform-package-source) |
645b9df8 | 402 | (with-input . ,transform-package-inputs) |
96915a44 | 403 | (with-graft . ,transform-package-inputs/graft) |
b18f7234 | 404 | (with-branch . ,transform-package-source-branch) |
880916ac LC |
405 | (with-commit . ,transform-package-source-commit) |
406 | (with-git-url . ,transform-package-source-git-url))) | |
88ad6ded LC |
407 | |
408 | (define %transformation-options | |
409 | ;; The command-line interface to the above transformations. | |
31c2fd1e LC |
410 | (let ((parser (lambda (symbol) |
411 | (lambda (opt name arg result . rest) | |
412 | (apply values | |
413 | (alist-cons symbol arg result) | |
414 | rest))))) | |
415 | (list (option '("with-source") #t #f | |
416 | (parser 'with-source)) | |
417 | (option '("with-input") #t #f | |
645b9df8 LC |
418 | (parser 'with-input)) |
419 | (option '("with-graft") #t #f | |
96915a44 LC |
420 | (parser 'with-graft)) |
421 | (option '("with-branch") #t #f | |
b18f7234 LC |
422 | (parser 'with-branch)) |
423 | (option '("with-commit") #t #f | |
880916ac LC |
424 | (parser 'with-commit)) |
425 | (option '("with-git-url") #t #f | |
426 | (parser 'with-git-url))))) | |
88ad6ded LC |
427 | |
428 | (define (show-transformation-options-help) | |
69daee23 | 429 | (display (G_ " |
88ad6ded | 430 | --with-source=SOURCE |
47c0f92c | 431 | use SOURCE when building the corresponding package")) |
69daee23 | 432 | (display (G_ " |
47c0f92c | 433 | --with-input=PACKAGE=REPLACEMENT |
645b9df8 | 434 | replace dependency PACKAGE by REPLACEMENT")) |
69daee23 | 435 | (display (G_ " |
645b9df8 | 436 | --with-graft=PACKAGE=REPLACEMENT |
96915a44 | 437 | graft REPLACEMENT on packages that refer to PACKAGE")) |
b18f7234 | 438 | (display (G_ " |
96915a44 | 439 | --with-branch=PACKAGE=BRANCH |
b18f7234 LC |
440 | build PACKAGE from the latest commit of BRANCH")) |
441 | (display (G_ " | |
442 | --with-commit=PACKAGE=COMMIT | |
880916ac LC |
443 | build PACKAGE from COMMIT")) |
444 | (display (G_ " | |
445 | --with-git-url=PACKAGE=URL | |
446 | build PACKAGE from the repository at URL"))) | |
88ad6ded LC |
447 | |
448 | ||
449 | (define (options->transformation opts) | |
450 | "Return a procedure that, when passed an object to build (package, | |
451 | derivation, etc.), applies the transformations specified by OPTS." | |
452 | (define applicable | |
14328b81 LC |
453 | ;; List of applicable transformations as symbol/procedure pairs in the |
454 | ;; order in which they appear on the command line. | |
88ad6ded | 455 | (filter-map (match-lambda |
14328b81 LC |
456 | ((key . value) |
457 | (match (any (match-lambda | |
458 | ((k . proc) | |
459 | (and (eq? k key) proc))) | |
460 | %transformations) | |
461 | (#f | |
462 | #f) | |
463 | (transform | |
464 | ;; XXX: We used to pass TRANSFORM a list of several | |
465 | ;; arguments, but we now pass only one, assuming that | |
466 | ;; transform composes well. | |
467 | (cons key (transform (list value))))))) | |
468 | (reverse opts))) | |
88ad6ded LC |
469 | |
470 | (lambda (store obj) | |
471 | (fold (match-lambda* | |
472 | (((name . transform) obj) | |
473 | (let ((new (transform store obj))) | |
474 | (when (eq? new obj) | |
69daee23 | 475 | (warning (G_ "transformation '~a' had no effect on ~a~%") |
88ad6ded LC |
476 | name |
477 | (if (package? obj) | |
478 | (package-full-name obj) | |
479 | obj))) | |
480 | new))) | |
481 | obj | |
482 | applicable))) | |
483 | ||
484 | \f | |
14a1c319 | 485 | ;;; |
e7fc17b5 | 486 | ;;; Standard command-line build options. |
14a1c319 LC |
487 | ;;; |
488 | ||
e7fc17b5 LC |
489 | (define (show-build-options-help) |
490 | "Display on the current output port help about the standard command-line | |
491 | options handled by 'set-build-options-from-command-line', and listed in | |
492 | '%standard-build-options'." | |
69daee23 | 493 | (display (G_ " |
300868ba | 494 | -L, --load-path=DIR prepend DIR to the package module search path")) |
69daee23 | 495 | (display (G_ " |
14a1c319 | 496 | -K, --keep-failed keep build tree of failed builds")) |
69daee23 | 497 | (display (G_ " |
f4953019 | 498 | -k, --keep-going keep going when some of the derivations fail")) |
69daee23 | 499 | (display (G_ " |
14a1c319 | 500 | -n, --dry-run do not build the derivations")) |
69daee23 | 501 | (display (G_ " |
56b1f4b7 | 502 | --fallback fall back to building when the substituter fails")) |
69daee23 | 503 | (display (G_ " |
692c6c15 | 504 | --no-substitutes build instead of resorting to pre-built substitutes")) |
69daee23 | 505 | (display (G_ " |
f8a8e0fe LC |
506 | --substitute-urls=URLS |
507 | fetch substitute from URLS if they are authorized")) | |
69daee23 | 508 | (display (G_ " |
7573d30f | 509 | --no-grafts do not graft packages")) |
69daee23 | 510 | (display (G_ " |
dc209d5a | 511 | --no-offload do not attempt to offload builds")) |
69daee23 | 512 | (display (G_ " |
969e678e LC |
513 | --max-silent-time=SECONDS |
514 | mark the build as failed after SECONDS of silence")) | |
69daee23 | 515 | (display (G_ " |
002622b6 | 516 | --timeout=SECONDS mark the build as failed after SECONDS of activity")) |
69daee23 | 517 | (display (G_ " |
5b74fe06 | 518 | --rounds=N build N times in a row to detect non-determinism")) |
69daee23 | 519 | (display (G_ " |
f6526eb3 | 520 | -c, --cores=N allow the use of up to N CPU cores for the build")) |
69daee23 | 521 | (display (G_ " |
f1de676e LC |
522 | -M, --max-jobs=N allow at most N build jobs")) |
523 | (display (G_ " | |
524 | --debug=LEVEL produce debugging output at LEVEL"))) | |
14a1c319 | 525 | |
e7fc17b5 LC |
526 | (define (set-build-options-from-command-line store opts) |
527 | "Given OPTS, an alist as returned by 'args-fold' given | |
528 | '%standard-build-options', set the corresponding build options on STORE." | |
b3673e99 LC |
529 | |
530 | ;; '--keep-failed' has no effect when talking to a remote daemon. Catch the | |
531 | ;; case where GUIX_DAEMON_SOCKET=guix://…. | |
532 | (when (and (assoc-ref opts 'keep-failed?) | |
533 | (let* ((socket (store-connection-socket store)) | |
534 | (peer (catch 'system-error | |
535 | (lambda () | |
536 | (and (file-port? socket) | |
537 | (getpeername socket))) | |
538 | (const #f)))) | |
539 | (and peer (not (= AF_UNIX (sockaddr:fam peer)))))) | |
540 | (warning (G_ "'--keep-failed' ignored since you are \ | |
541 | talking to a remote daemon\n"))) | |
542 | ||
e7fc17b5 LC |
543 | (set-build-options store |
544 | #:keep-failed? (assoc-ref opts 'keep-failed?) | |
f4953019 | 545 | #:keep-going? (assoc-ref opts 'keep-going?) |
5b74fe06 | 546 | #:rounds (assoc-ref opts 'rounds) |
d9da3a75 LC |
547 | #:build-cores (assoc-ref opts 'cores) |
548 | #:max-build-jobs (assoc-ref opts 'max-jobs) | |
e7fc17b5 LC |
549 | #:fallback? (assoc-ref opts 'fallback?) |
550 | #:use-substitutes? (assoc-ref opts 'substitutes?) | |
fb4bf72b | 551 | #:substitute-urls (assoc-ref opts 'substitute-urls) |
2ce08a5d LC |
552 | #:offload? (and (assoc-ref opts 'offload?) |
553 | (not (assoc-ref opts 'keep-failed?))) | |
e7fc17b5 | 554 | #:max-silent-time (assoc-ref opts 'max-silent-time) |
002622b6 | 555 | #:timeout (assoc-ref opts 'timeout) |
b6b097ac | 556 | #:print-build-trace (assoc-ref opts 'print-build-trace?) |
dc0f74e5 LC |
557 | #:print-extended-build-trace? |
558 | (assoc-ref opts 'print-extended-build-trace?) | |
f9a8fce1 LC |
559 | #:multiplexed-build-output? |
560 | (assoc-ref opts 'multiplexed-build-output?) | |
f1de676e | 561 | #:verbosity (assoc-ref opts 'debug))) |
14a1c319 | 562 | |
2d977638 DT |
563 | (define set-build-options-from-command-line* |
564 | (store-lift set-build-options-from-command-line)) | |
565 | ||
e7fc17b5 LC |
566 | (define %standard-build-options |
567 | ;; List of standard command-line options for tools that build something. | |
300868ba LC |
568 | (list (option '(#\L "load-path") #t #f |
569 | (lambda (opt name arg result . rest) | |
570 | ;; XXX: Imperatively modify the search paths. | |
571 | (%package-module-path (cons arg (%package-module-path))) | |
223d7939 | 572 | (%patch-path (cons arg (%patch-path))) |
300868ba LC |
573 | (set! %load-path (cons arg %load-path)) |
574 | (set! %load-compiled-path (cons arg %load-compiled-path)) | |
575 | ||
576 | (apply values (cons result rest)))) | |
577 | (option '(#\K "keep-failed") #f #f | |
dd67b429 LC |
578 | (lambda (opt name arg result . rest) |
579 | (apply values | |
580 | (alist-cons 'keep-failed? #t result) | |
581 | rest))) | |
f4953019 LC |
582 | (option '(#\k "keep-going") #f #f |
583 | (lambda (opt name arg result . rest) | |
584 | (apply values | |
585 | (alist-cons 'keep-going? #t result) | |
586 | rest))) | |
5b74fe06 LC |
587 | (option '("rounds") #t #f |
588 | (lambda (opt name arg result . rest) | |
589 | (apply values | |
590 | (alist-cons 'rounds (string->number* arg) | |
591 | result) | |
592 | rest))) | |
56b1f4b7 | 593 | (option '("fallback") #f #f |
dd67b429 LC |
594 | (lambda (opt name arg result . rest) |
595 | (apply values | |
596 | (alist-cons 'fallback? #t | |
597 | (alist-delete 'fallback? result)) | |
598 | rest))) | |
692c6c15 | 599 | (option '("no-substitutes") #f #f |
dd67b429 LC |
600 | (lambda (opt name arg result . rest) |
601 | (apply values | |
602 | (alist-cons 'substitutes? #f | |
603 | (alist-delete 'substitutes? result)) | |
604 | rest))) | |
f8a8e0fe LC |
605 | (option '("substitute-urls") #t #f |
606 | (lambda (opt name arg result . rest) | |
607 | (apply values | |
608 | (alist-cons 'substitute-urls | |
609 | (string-tokenize arg) | |
610 | (alist-delete 'substitute-urls result)) | |
611 | rest))) | |
7573d30f LC |
612 | (option '("no-grafts") #f #f |
613 | (lambda (opt name arg result . rest) | |
614 | (apply values | |
615 | (alist-cons 'graft? #f | |
616 | (alist-delete 'graft? result eq?)) | |
617 | rest))) | |
dc209d5a | 618 | (option '("no-offload" "no-build-hook") #f #f |
dd67b429 | 619 | (lambda (opt name arg result . rest) |
dc209d5a LC |
620 | (when (string=? name "no-build-hook") |
621 | (warning (G_ "'--no-build-hook' is deprecated; \ | |
622 | use '--no-offload' instead~%"))) | |
623 | ||
dd67b429 | 624 | (apply values |
7f44ab48 LC |
625 | (alist-cons 'offload? #f |
626 | (alist-delete 'offload? result)) | |
dd67b429 | 627 | rest))) |
969e678e | 628 | (option '("max-silent-time") #t #f |
dd67b429 LC |
629 | (lambda (opt name arg result . rest) |
630 | (apply values | |
631 | (alist-cons 'max-silent-time (string->number* arg) | |
632 | result) | |
633 | rest))) | |
002622b6 LC |
634 | (option '("timeout") #t #f |
635 | (lambda (opt name arg result . rest) | |
636 | (apply values | |
637 | (alist-cons 'timeout (string->number* arg) result) | |
638 | rest))) | |
f1de676e | 639 | (option '("debug") #t #f |
dd67b429 | 640 | (lambda (opt name arg result . rest) |
f1de676e | 641 | (let ((level (string->number* arg))) |
dd67b429 | 642 | (apply values |
f1de676e LC |
643 | (alist-cons 'debug level |
644 | (alist-delete 'debug result)) | |
dd67b429 | 645 | rest)))) |
e7fc17b5 | 646 | (option '(#\c "cores") #t #f |
dd67b429 | 647 | (lambda (opt name arg result . rest) |
e7fc17b5 LC |
648 | (let ((c (false-if-exception (string->number arg)))) |
649 | (if c | |
dd67b429 | 650 | (apply values (alist-cons 'cores c result) rest) |
69daee23 | 651 | (leave (G_ "not a number: '~a' option argument: ~a~%") |
f6526eb3 LC |
652 | name arg))))) |
653 | (option '(#\M "max-jobs") #t #f | |
654 | (lambda (opt name arg result . rest) | |
655 | (let ((c (false-if-exception (string->number arg)))) | |
656 | (if c | |
657 | (apply values (alist-cons 'max-jobs c result) rest) | |
69daee23 | 658 | (leave (G_ "not a number: '~a' option argument: ~a~%") |
f6526eb3 | 659 | name arg))))))) |
e7fc17b5 LC |
660 | |
661 | \f | |
662 | ;;; | |
663 | ;;; Command-line options. | |
664 | ;;; | |
665 | ||
666 | (define %default-options | |
667 | ;; Alist of default option values. | |
ea261dea | 668 | `((build-mode . ,(build-mode normal)) |
05962f29 | 669 | (graft? . #t) |
e7fc17b5 | 670 | (substitutes? . #t) |
7f44ab48 | 671 | (offload? . #t) |
b6b097ac | 672 | (print-build-trace? . #t) |
dc0f74e5 | 673 | (print-extended-build-trace? . #t) |
f9a8fce1 | 674 | (multiplexed-build-output? . #t) |
f1de676e LC |
675 | (verbosity . 2) |
676 | (debug . 0))) | |
e7fc17b5 LC |
677 | |
678 | (define (show-help) | |
69daee23 | 679 | (display (G_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... |
e7fc17b5 | 680 | Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) |
69daee23 | 681 | (display (G_ " |
e7fc17b5 | 682 | -e, --expression=EXPR build the package or derivation EXPR evaluates to")) |
69daee23 | 683 | (display (G_ " |
34a1783f DT |
684 | -f, --file=FILE build the package or derivation that the code within |
685 | FILE evaluates to")) | |
69daee23 | 686 | (display (G_ " |
11415d35 MB |
687 | -m, --manifest=FILE build the packages that the manifest given in FILE |
688 | evaluates to")) | |
689 | (display (G_ " | |
e7fc17b5 | 690 | -S, --source build the packages' source derivations")) |
69daee23 | 691 | (display (G_ " |
2087023d | 692 | --sources[=TYPE] build source derivations; TYPE may optionally be one |
2cdfe13d | 693 | of \"package\", \"all\" (default), or \"transitive\"")) |
69daee23 | 694 | (display (G_ " |
e7fc17b5 | 695 | -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) |
69daee23 | 696 | (display (G_ " |
e7fc17b5 | 697 | --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) |
69daee23 | 698 | (display (G_ " |
e7fc17b5 | 699 | -d, --derivations return the derivation paths of the given packages")) |
69daee23 | 700 | (display (G_ " |
a8d65643 | 701 | --check rebuild items to check for non-determinism issues")) |
69daee23 | 702 | (display (G_ " |
6da5bb7b | 703 | --repair repair the specified items")) |
69daee23 | 704 | (display (G_ " |
e7fc17b5 LC |
705 | -r, --root=FILE make FILE a symlink to the result, and register it |
706 | as a garbage collector root")) | |
69daee23 | 707 | (display (G_ " |
f1de676e LC |
708 | -v, --verbosity=LEVEL use the given verbosity LEVEL")) |
709 | (display (G_ " | |
5284339d | 710 | -q, --quiet do not show the build log")) |
69daee23 | 711 | (display (G_ " |
e7fc17b5 LC |
712 | --log-file return the log file names for the given derivations")) |
713 | (newline) | |
714 | (show-build-options-help) | |
715 | (newline) | |
88ad6ded LC |
716 | (show-transformation-options-help) |
717 | (newline) | |
69daee23 | 718 | (display (G_ " |
e7fc17b5 | 719 | -h, --help display this help and exit")) |
69daee23 | 720 | (display (G_ " |
e7fc17b5 LC |
721 | -V, --version display version information and exit")) |
722 | (newline) | |
723 | (show-bug-report-information)) | |
724 | ||
725 | (define %options | |
726 | ;; Specifications of the command-line options. | |
727 | (cons* (option '(#\h "help") #f #f | |
728 | (lambda args | |
729 | (show-help) | |
730 | (exit 0))) | |
731 | (option '(#\V "version") #f #f | |
732 | (lambda args | |
733 | (show-version-and-exit "guix build"))) | |
e7fc17b5 LC |
734 | (option '(#\S "source") #f #f |
735 | (lambda (opt name arg result) | |
2cdfe13d EB |
736 | (alist-cons 'source #t result))) |
737 | (option '("sources") #f #t | |
738 | (lambda (opt name arg result) | |
739 | (match arg | |
740 | ("package" | |
741 | (alist-cons 'source #t result)) | |
742 | ((or "all" #f) | |
743 | (alist-cons 'source package-direct-sources result)) | |
744 | ("transitive" | |
745 | (alist-cons 'source package-transitive-sources result)) | |
746 | (else | |
69daee23 | 747 | (leave (G_ "invalid argument: '~a' option argument: ~a, ~ |
2cdfe13d EB |
748 | must be one of 'package', 'all', or 'transitive'~%") |
749 | name arg))))) | |
88ad6ded LC |
750 | (option '("check") #f #f |
751 | (lambda (opt name arg result . rest) | |
752 | (apply values | |
753 | (alist-cons 'build-mode (build-mode check) | |
754 | result) | |
755 | rest))) | |
6da5bb7b LC |
756 | (option '("repair") #f #f |
757 | (lambda (opt name arg result . rest) | |
758 | (apply values | |
759 | (alist-cons 'build-mode (build-mode repair) | |
760 | result) | |
761 | rest))) | |
e7fc17b5 LC |
762 | (option '(#\s "system") #t #f |
763 | (lambda (opt name arg result) | |
ea261dea | 764 | (alist-cons 'system arg result))) |
e7fc17b5 LC |
765 | (option '("target") #t #f |
766 | (lambda (opt name arg result) | |
767 | (alist-cons 'target arg | |
768 | (alist-delete 'target result eq?)))) | |
769 | (option '(#\d "derivations") #f #f | |
770 | (lambda (opt name arg result) | |
771 | (alist-cons 'derivations-only? #t result))) | |
772 | (option '(#\e "expression") #t #f | |
773 | (lambda (opt name arg result) | |
774 | (alist-cons 'expression arg result))) | |
34a1783f DT |
775 | (option '(#\f "file") #t #f |
776 | (lambda (opt name arg result) | |
777 | (alist-cons 'file arg result))) | |
11415d35 MB |
778 | (option '(#\m "manifest") #t #f |
779 | (lambda (opt name arg result) | |
780 | (alist-cons 'manifest arg result))) | |
e7fc17b5 LC |
781 | (option '(#\n "dry-run") #f #f |
782 | (lambda (opt name arg result) | |
131f50cd | 783 | (alist-cons 'dry-run? #t result))) |
e7fc17b5 LC |
784 | (option '(#\r "root") #t #f |
785 | (lambda (opt name arg result) | |
786 | (alist-cons 'gc-root arg result))) | |
f1de676e LC |
787 | (option '(#\v "verbosity") #t #f |
788 | (lambda (opt name arg result) | |
789 | (let ((level (string->number* arg))) | |
790 | (alist-cons 'verbosity level | |
791 | (alist-delete 'verbosity result))))) | |
5284339d LC |
792 | (option '(#\q "quiet") #f #f |
793 | (lambda (opt name arg result) | |
f1de676e LC |
794 | (alist-cons 'verbosity 0 |
795 | (alist-delete 'verbosity result)))) | |
e7fc17b5 LC |
796 | (option '("log-file") #f #f |
797 | (lambda (opt name arg result) | |
798 | (alist-cons 'log-file? #t result))) | |
799 | ||
88ad6ded LC |
800 | (append %transformation-options |
801 | %standard-build-options))) | |
14a1c319 | 802 | |
64ec0e29 LC |
803 | (define (options->things-to-build opts) |
804 | "Read the arguments from OPTS and return a list of high-level objects to | |
805 | build---packages, gexps, derivations, and so on." | |
20464dde | 806 | (define (validate-type x) |
b33e191c | 807 | (unless (or (derivation? x) (file-like? x) (gexp? x) (procedure? x)) |
69daee23 | 808 | (leave (G_ "~s: not something we can build~%") x))) |
20464dde LC |
809 | |
810 | (define (ensure-list x) | |
811 | (let ((lst (match x | |
812 | ((x ...) x) | |
813 | (x (list x))))) | |
814 | (for-each validate-type lst) | |
815 | lst)) | |
64ec0e29 LC |
816 | |
817 | (append-map (match-lambda | |
818 | (('argument . (? string? spec)) | |
819 | (cond ((derivation-path? spec) | |
9c9982dc LC |
820 | (catch 'system-error |
821 | (lambda () | |
09238d61 LC |
822 | ;; Ask for absolute file names so that .drv file |
823 | ;; names passed from the user to 'read-derivation' | |
824 | ;; are absolute when it returns. | |
825 | (let ((spec (canonicalize-path spec))) | |
826 | (list (read-derivation-from-file spec)))) | |
9c9982dc LC |
827 | (lambda args |
828 | ;; Non-existent .drv files can be substituted down | |
829 | ;; the road, so don't error out. | |
830 | (if (= ENOENT (system-error-errno args)) | |
831 | '() | |
832 | (apply throw args))))) | |
64ec0e29 LC |
833 | ((store-path? spec) |
834 | ;; Nothing to do; maybe for --log-file. | |
835 | '()) | |
836 | (else | |
837 | (list (specification->package spec))))) | |
838 | (('file . file) | |
f87e5632 RW |
839 | (let ((file (or (and (string-suffix? ".json" file) |
840 | (json->scheme-file file)) | |
841 | file))) | |
842 | (ensure-list (load* file (make-user-module '()))))) | |
11415d35 | 843 | (('manifest . manifest) |
5a675b2c LC |
844 | (map manifest-entry-item |
845 | (manifest-entries | |
846 | (load* manifest | |
847 | (make-user-module '((guix profiles) (gnu))))))) | |
64ec0e29 LC |
848 | (('expression . str) |
849 | (ensure-list (read/eval str))) | |
850 | (('argument . (? derivation? drv)) | |
851 | drv) | |
64ec0e29 LC |
852 | (_ '())) |
853 | opts)) | |
854 | ||
81fa80b2 LC |
855 | (define (options->derivations store opts) |
856 | "Given OPTS, the result of 'args-fold', return a list of derivations to | |
857 | build." | |
64ec0e29 LC |
858 | (define transform |
859 | (options->transformation opts)) | |
860 | ||
81fa80b2 LC |
861 | (define package->derivation |
862 | (match (assoc-ref opts 'target) | |
863 | (#f package-derivation) | |
864 | (triplet | |
865 | (cut package-cross-derivation <> <> triplet <>)))) | |
866 | ||
2cdfe13d | 867 | (define src (assoc-ref opts 'source)) |
05962f29 | 868 | (define graft? (assoc-ref opts 'graft?)) |
ea261dea LC |
869 | (define systems |
870 | (match (filter-map (match-lambda | |
871 | (('system . system) system) | |
872 | (_ #f)) | |
873 | opts) | |
874 | (() (list (%current-system))) | |
875 | (systems systems))) | |
876 | ||
877 | (define things-to-build | |
878 | (map (cut transform store <>) | |
879 | (options->things-to-build opts))) | |
880 | ||
881 | (define (compute-derivation obj system) | |
882 | ;; Compute the derivation of OBJ for SYSTEM. | |
883 | (match obj | |
884 | ((? package? p) | |
885 | (let ((p (or (and graft? (package-replacement p)) p))) | |
886 | (match src | |
887 | (#f | |
888 | (list (package->derivation store p system))) | |
889 | (#t | |
890 | (match (package-source p) | |
891 | (#f | |
0f2d9c32 LC |
892 | (warning (package-location p) |
893 | (G_ "package '~a' has no source~%") | |
894 | (package-name p)) | |
ea261dea LC |
895 | '()) |
896 | (s | |
897 | (list (package-source-derivation store s))))) | |
898 | (proc | |
899 | (map (cut package-source-derivation store <>) | |
900 | (proc p)))))) | |
901 | ((? derivation? drv) | |
902 | (list drv)) | |
903 | ((? procedure? proc) | |
904 | (list (run-with-store store | |
905 | (mbegin %store-monad | |
906 | (set-guile-for-build (default-guile)) | |
907 | (proc)) | |
908 | #:system system))) | |
909 | ((? file-like? obj) | |
910 | (list (run-with-store store | |
911 | (lower-object obj system | |
912 | #:target (assoc-ref opts 'target)) | |
913 | #:system system))) | |
914 | ((? gexp? gexp) | |
915 | (list (run-with-store store | |
916 | (mbegin %store-monad | |
917 | (set-guile-for-build (default-guile)) | |
918 | (gexp->derivation "gexp" gexp | |
919 | #:system system)) | |
920 | #:system system))))) | |
81fa80b2 | 921 | |
2d2f98ef LC |
922 | ;; We may get 'unbound-variable' errors while evaluating the 'inputs' fields |
923 | ;; of user packages. Since 'guix build' is the primary tool for people | |
924 | ;; testing new packages, report such errors gracefully. | |
925 | (with-unbound-variable-handling | |
926 | (parameterize ((%graft? graft?)) | |
ea261dea | 927 | (append-map (lambda (system) |
1213ea9b LC |
928 | (concatenate |
929 | (map/accumulate-builds store | |
930 | (cut compute-derivation <> system) | |
931 | things-to-build))) | |
ea261dea | 932 | systems)))) |
64ec0e29 | 933 | |
841cb43c LC |
934 | (define (show-build-log store file urls) |
935 | "Show the build log for FILE, falling back to remote logs from URLS if | |
936 | needed." | |
937 | (let ((log (or (log-file store file) | |
938 | (log-url store file #:base-urls urls)))) | |
939 | (if log | |
940 | (format #t "~a~%" log) | |
69daee23 | 941 | (leave (G_ "no build log for '~a'~%") file)))) |
841cb43c | 942 | |
14a1c319 LC |
943 | \f |
944 | ;;; | |
945 | ;;; Entry point. | |
946 | ;;; | |
947 | ||
3794ce93 LC |
948 | (define-command (guix-build . args) |
949 | (category packaging) | |
950 | (synopsis "build packages or derivations without installing them") | |
951 | ||
c8f9f247 LC |
952 | (define opts |
953 | (parse-command-line args %options | |
954 | (list %default-options))) | |
955 | ||
f42f39ad LC |
956 | (define graft? |
957 | (assoc-ref opts 'graft?)) | |
958 | ||
073c34d7 | 959 | (with-error-handling |
09238d61 LC |
960 | (with-status-verbosity (assoc-ref opts 'verbosity) |
961 | (with-store store | |
962 | ;; Set the build options before we do anything else. | |
963 | (set-build-options-from-command-line store opts) | |
964 | ||
62195b9a LC |
965 | (with-build-handler (build-notifier #:use-substitutes? |
966 | (assoc-ref opts 'substitutes?) | |
898e6d0a LC |
967 | #:verbosity |
968 | (assoc-ref opts 'verbosity) | |
62195b9a LC |
969 | #:dry-run? |
970 | (assoc-ref opts 'dry-run?)) | |
971 | (parameterize ((current-terminal-columns (terminal-columns)) | |
972 | ||
973 | ;; Set grafting upfront in case the user's input | |
974 | ;; depends on it (e.g., a manifest or code snippet that | |
975 | ;; calls 'gexp->derivation'). | |
976 | (%graft? graft?)) | |
977 | (let* ((mode (assoc-ref opts 'build-mode)) | |
978 | (drv (options->derivations store opts)) | |
979 | (urls (map (cut string-append <> "/log") | |
980 | (if (assoc-ref opts 'substitutes?) | |
981 | (or (assoc-ref opts 'substitute-urls) | |
982 | ;; XXX: This does not necessarily match the | |
983 | ;; daemon's substitute URLs. | |
984 | %default-substitute-urls) | |
985 | '()))) | |
986 | (items (filter-map (match-lambda | |
987 | (('argument . (? store-path? file)) | |
988 | ;; If FILE is a .drv that's not in | |
989 | ;; store, keep it so that it can be | |
990 | ;; substituted. | |
991 | (and (or (not (derivation-path? file)) | |
992 | (not (file-exists? file))) | |
993 | file)) | |
994 | (_ #f)) | |
995 | opts)) | |
996 | (roots (filter-map (match-lambda | |
997 | (('gc-root . root) root) | |
998 | (_ #f)) | |
999 | opts))) | |
1000 | ||
1001 | (cond ((assoc-ref opts 'log-file?) | |
1002 | ;; Pass 'show-build-log' the output file names, not the | |
1003 | ;; derivation file names, because there can be several | |
1004 | ;; derivations leading to the same output. | |
1005 | (for-each (cut show-build-log store <> urls) | |
1006 | (delete-duplicates | |
1007 | (append (map derivation->output-path drv) | |
1008 | items)))) | |
1009 | ((assoc-ref opts 'derivations-only?) | |
1010 | (format #t "~{~a~%~}" (map derivation-file-name drv)) | |
1011 | (for-each (cut register-root store <> <>) | |
1012 | (map (compose list derivation-file-name) drv) | |
1013 | roots)) | |
1014 | (else | |
1015 | (and (build-derivations store (append drv items) | |
1016 | mode) | |
1017 | (for-each show-derivation-outputs drv) | |
1018 | (for-each (cut register-root store <> <>) | |
1019 | (map (lambda (drv) | |
1020 | (map cdr | |
1021 | (derivation->output-paths drv))) | |
1022 | drv) | |
1023 | roots))))))))))) |