Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
e87f0591 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> |
dc5669cd | 3 | ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> |
14a1c319 | 4 | ;;; |
233e7676 | 5 | ;;; This file is part of GNU Guix. |
14a1c319 | 6 | ;;; |
233e7676 | 7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
14a1c319 LC |
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 | ;;; | |
233e7676 | 12 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
14a1c319 LC |
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 | |
233e7676 | 18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
14a1c319 | 19 | |
e49951eb | 20 | (define-module (guix scripts build) |
073c34d7 | 21 | #:use-module (guix ui) |
14a1c319 LC |
22 | #:use-module (guix store) |
23 | #:use-module (guix derivations) | |
24 | #:use-module (guix packages) | |
07783858 | 25 | #:use-module (guix utils) |
ac5de156 | 26 | #:use-module (guix monads) |
56b82106 | 27 | #:use-module (guix gexp) |
14a1c319 LC |
28 | #:use-module (ice-9 format) |
29 | #:use-module (ice-9 match) | |
dc5669cd | 30 | #:use-module (ice-9 vlist) |
14a1c319 | 31 | #:use-module (srfi srfi-1) |
5401dd75 | 32 | #:use-module (srfi srfi-11) |
14a1c319 | 33 | #:use-module (srfi srfi-26) |
07783858 | 34 | #:use-module (srfi srfi-34) |
14a1c319 | 35 | #:use-module (srfi srfi-37) |
300868ba | 36 | #:autoload (gnu packages) (specification->package %package-module-path) |
7f3673f2 | 37 | #:autoload (guix download) (download-to-store) |
257b9341 | 38 | #:export (%standard-build-options |
e7fc17b5 LC |
39 | set-build-options-from-command-line |
40 | show-build-options-help | |
41 | ||
760c60d6 | 42 | guix-build)) |
14a1c319 | 43 | |
81fa80b2 LC |
44 | (define (register-root store paths root) |
45 | "Register ROOT as an indirect GC root for all of PATHS." | |
46 | (let* ((root (string-append (canonicalize-path (dirname root)) | |
47 | "/" root))) | |
48 | (catch 'system-error | |
49 | (lambda () | |
50 | (match paths | |
51 | ((path) | |
52 | (symlink path root) | |
53 | (add-indirect-root store root)) | |
54 | ((paths ...) | |
55 | (fold (lambda (path count) | |
56 | (let ((root (string-append root | |
57 | "-" | |
58 | (number->string count)))) | |
59 | (symlink path root) | |
60 | (add-indirect-root store root)) | |
61 | (+ 1 count)) | |
62 | 0 | |
63 | paths)))) | |
64 | (lambda args | |
65 | (leave (_ "failed to create GC root `~a': ~a~%") | |
66 | root (strerror (system-error-errno args))))))) | |
67 | ||
7f3673f2 LC |
68 | (define (package-with-source store p uri) |
69 | "Return a package based on P but with its source taken from URI. Extract | |
70 | the new package's version number from URI." | |
71 | (define (numeric-extension? file-name) | |
72 | ;; Return true if FILE-NAME ends with digits. | |
73 | (string-every char-set:hex-digit (file-extension file-name))) | |
74 | ||
75 | (define (tarball-base-name file-name) | |
76 | ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar | |
77 | ;; extensions. | |
78 | ;; TODO: Factorize. | |
79 | (cond ((numeric-extension? file-name) | |
80 | file-name) | |
81 | ((string=? (file-extension file-name) "tar") | |
82 | (file-sans-extension file-name)) | |
83 | (else | |
84 | (tarball-base-name (file-sans-extension file-name))))) | |
85 | ||
86 | (let ((base (tarball-base-name (basename uri)))) | |
87 | (let-values (((name version) | |
88 | (package-name->name+version base))) | |
89 | (package (inherit p) | |
90 | (version (or version (package-version p))) | |
91 | (source (download-to-store store uri)))))) | |
92 | ||
14a1c319 LC |
93 | \f |
94 | ;;; | |
e7fc17b5 | 95 | ;;; Standard command-line build options. |
14a1c319 LC |
96 | ;;; |
97 | ||
e7fc17b5 LC |
98 | (define (show-build-options-help) |
99 | "Display on the current output port help about the standard command-line | |
100 | options handled by 'set-build-options-from-command-line', and listed in | |
101 | '%standard-build-options'." | |
300868ba LC |
102 | (display (_ " |
103 | -L, --load-path=DIR prepend DIR to the package module search path")) | |
609354bf | 104 | (display (_ " |
14a1c319 LC |
105 | -K, --keep-failed keep build tree of failed builds")) |
106 | (display (_ " | |
107 | -n, --dry-run do not build the derivations")) | |
56b1f4b7 LC |
108 | (display (_ " |
109 | --fallback fall back to building when the substituter fails")) | |
1c3972da | 110 | (display (_ " |
692c6c15 | 111 | --no-substitutes build instead of resorting to pre-built substitutes")) |
425b0bfc LC |
112 | (display (_ " |
113 | --no-build-hook do not attempt to offload builds via the build hook")) | |
969e678e LC |
114 | (display (_ " |
115 | --max-silent-time=SECONDS | |
116 | mark the build as failed after SECONDS of silence")) | |
002622b6 LC |
117 | (display (_ " |
118 | --timeout=SECONDS mark the build as failed after SECONDS of activity")) | |
07ab4bf1 LC |
119 | (display (_ " |
120 | --verbosity=LEVEL use the given verbosity LEVEL")) | |
bf421152 | 121 | (display (_ " |
f6526eb3 LC |
122 | -c, --cores=N allow the use of up to N CPU cores for the build")) |
123 | (display (_ " | |
124 | -M, --max-jobs=N allow at most N build jobs"))) | |
14a1c319 | 125 | |
e7fc17b5 LC |
126 | (define (set-build-options-from-command-line store opts) |
127 | "Given OPTS, an alist as returned by 'args-fold' given | |
128 | '%standard-build-options', set the corresponding build options on STORE." | |
129 | ;; TODO: Add more options. | |
130 | (set-build-options store | |
131 | #:keep-failed? (assoc-ref opts 'keep-failed?) | |
132 | #:build-cores (or (assoc-ref opts 'cores) 0) | |
f6526eb3 | 133 | #:max-build-jobs (or (assoc-ref opts 'max-jobs) 1) |
e7fc17b5 LC |
134 | #:fallback? (assoc-ref opts 'fallback?) |
135 | #:use-substitutes? (assoc-ref opts 'substitutes?) | |
136 | #:use-build-hook? (assoc-ref opts 'build-hook?) | |
137 | #:max-silent-time (assoc-ref opts 'max-silent-time) | |
002622b6 | 138 | #:timeout (assoc-ref opts 'timeout) |
b6b097ac | 139 | #:print-build-trace (assoc-ref opts 'print-build-trace?) |
e7fc17b5 | 140 | #:verbosity (assoc-ref opts 'verbosity))) |
14a1c319 | 141 | |
e7fc17b5 LC |
142 | (define %standard-build-options |
143 | ;; List of standard command-line options for tools that build something. | |
300868ba LC |
144 | (list (option '(#\L "load-path") #t #f |
145 | (lambda (opt name arg result . rest) | |
146 | ;; XXX: Imperatively modify the search paths. | |
147 | (%package-module-path (cons arg (%package-module-path))) | |
148 | (set! %load-path (cons arg %load-path)) | |
149 | (set! %load-compiled-path (cons arg %load-compiled-path)) | |
150 | ||
151 | (apply values (cons result rest)))) | |
152 | (option '(#\K "keep-failed") #f #f | |
dd67b429 LC |
153 | (lambda (opt name arg result . rest) |
154 | (apply values | |
155 | (alist-cons 'keep-failed? #t result) | |
156 | rest))) | |
56b1f4b7 | 157 | (option '("fallback") #f #f |
dd67b429 LC |
158 | (lambda (opt name arg result . rest) |
159 | (apply values | |
160 | (alist-cons 'fallback? #t | |
161 | (alist-delete 'fallback? result)) | |
162 | rest))) | |
692c6c15 | 163 | (option '("no-substitutes") #f #f |
dd67b429 LC |
164 | (lambda (opt name arg result . rest) |
165 | (apply values | |
166 | (alist-cons 'substitutes? #f | |
167 | (alist-delete 'substitutes? result)) | |
168 | rest))) | |
425b0bfc | 169 | (option '("no-build-hook") #f #f |
dd67b429 LC |
170 | (lambda (opt name arg result . rest) |
171 | (apply values | |
172 | (alist-cons 'build-hook? #f | |
173 | (alist-delete 'build-hook? result)) | |
174 | rest))) | |
969e678e | 175 | (option '("max-silent-time") #t #f |
dd67b429 LC |
176 | (lambda (opt name arg result . rest) |
177 | (apply values | |
178 | (alist-cons 'max-silent-time (string->number* arg) | |
179 | result) | |
180 | rest))) | |
002622b6 LC |
181 | (option '("timeout") #t #f |
182 | (lambda (opt name arg result . rest) | |
183 | (apply values | |
184 | (alist-cons 'timeout (string->number* arg) result) | |
185 | rest))) | |
07ab4bf1 | 186 | (option '("verbosity") #t #f |
dd67b429 | 187 | (lambda (opt name arg result . rest) |
07ab4bf1 | 188 | (let ((level (string->number arg))) |
dd67b429 LC |
189 | (apply values |
190 | (alist-cons 'verbosity level | |
191 | (alist-delete 'verbosity result)) | |
192 | rest)))) | |
e7fc17b5 | 193 | (option '(#\c "cores") #t #f |
dd67b429 | 194 | (lambda (opt name arg result . rest) |
e7fc17b5 LC |
195 | (let ((c (false-if-exception (string->number arg)))) |
196 | (if c | |
dd67b429 | 197 | (apply values (alist-cons 'cores c result) rest) |
f6526eb3 LC |
198 | (leave (_ "not a number: '~a' option argument: ~a~%") |
199 | name arg))))) | |
200 | (option '(#\M "max-jobs") #t #f | |
201 | (lambda (opt name arg result . rest) | |
202 | (let ((c (false-if-exception (string->number arg)))) | |
203 | (if c | |
204 | (apply values (alist-cons 'max-jobs c result) rest) | |
205 | (leave (_ "not a number: '~a' option argument: ~a~%") | |
206 | name arg))))))) | |
e7fc17b5 LC |
207 | |
208 | \f | |
209 | ;;; | |
210 | ;;; Command-line options. | |
211 | ;;; | |
212 | ||
213 | (define %default-options | |
214 | ;; Alist of default option values. | |
215 | `((system . ,(%current-system)) | |
05962f29 | 216 | (graft? . #t) |
e7fc17b5 LC |
217 | (substitutes? . #t) |
218 | (build-hook? . #t) | |
b6b097ac | 219 | (print-build-trace? . #t) |
e7fc17b5 LC |
220 | (max-silent-time . 3600) |
221 | (verbosity . 0))) | |
222 | ||
223 | (define (show-help) | |
224 | (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... | |
225 | Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) | |
226 | (display (_ " | |
227 | -e, --expression=EXPR build the package or derivation EXPR evaluates to")) | |
228 | (display (_ " | |
229 | -S, --source build the packages' source derivations")) | |
230 | (display (_ " | |
2cdfe13d EB |
231 | --sources[=TYPE] build source derivations; TYPE may optionally be one |
232 | of \"package\", \"all\" (default), or \"transitive\"")) | |
233 | (display (_ " | |
e7fc17b5 LC |
234 | -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) |
235 | (display (_ " | |
236 | --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) | |
7f3673f2 LC |
237 | (display (_ " |
238 | --with-source=SOURCE | |
239 | use SOURCE when building the corresponding package")) | |
05962f29 LC |
240 | (display (_ " |
241 | --no-grafts do not graft packages")) | |
e7fc17b5 LC |
242 | (display (_ " |
243 | -d, --derivations return the derivation paths of the given packages")) | |
244 | (display (_ " | |
245 | -r, --root=FILE make FILE a symlink to the result, and register it | |
246 | as a garbage collector root")) | |
247 | (display (_ " | |
248 | --log-file return the log file names for the given derivations")) | |
249 | (newline) | |
250 | (show-build-options-help) | |
251 | (newline) | |
252 | (display (_ " | |
253 | -h, --help display this help and exit")) | |
254 | (display (_ " | |
255 | -V, --version display version information and exit")) | |
256 | (newline) | |
257 | (show-bug-report-information)) | |
258 | ||
259 | (define %options | |
260 | ;; Specifications of the command-line options. | |
261 | (cons* (option '(#\h "help") #f #f | |
262 | (lambda args | |
263 | (show-help) | |
264 | (exit 0))) | |
265 | (option '(#\V "version") #f #f | |
266 | (lambda args | |
267 | (show-version-and-exit "guix build"))) | |
e7fc17b5 LC |
268 | (option '(#\S "source") #f #f |
269 | (lambda (opt name arg result) | |
2cdfe13d EB |
270 | (alist-cons 'source #t result))) |
271 | (option '("sources") #f #t | |
272 | (lambda (opt name arg result) | |
273 | (match arg | |
274 | ("package" | |
275 | (alist-cons 'source #t result)) | |
276 | ((or "all" #f) | |
277 | (alist-cons 'source package-direct-sources result)) | |
278 | ("transitive" | |
279 | (alist-cons 'source package-transitive-sources result)) | |
280 | (else | |
281 | (leave (_ "invalid argument: '~a' option argument: ~a, ~ | |
282 | must be one of 'package', 'all', or 'transitive'~%") | |
283 | name arg))))) | |
e7fc17b5 LC |
284 | (option '(#\s "system") #t #f |
285 | (lambda (opt name arg result) | |
286 | (alist-cons 'system arg | |
287 | (alist-delete 'system result eq?)))) | |
288 | (option '("target") #t #f | |
289 | (lambda (opt name arg result) | |
290 | (alist-cons 'target arg | |
291 | (alist-delete 'target result eq?)))) | |
292 | (option '(#\d "derivations") #f #f | |
293 | (lambda (opt name arg result) | |
294 | (alist-cons 'derivations-only? #t result))) | |
295 | (option '(#\e "expression") #t #f | |
296 | (lambda (opt name arg result) | |
297 | (alist-cons 'expression arg result))) | |
298 | (option '(#\n "dry-run") #f #f | |
299 | (lambda (opt name arg result) | |
300 | (alist-cons 'dry-run? #t result))) | |
301 | (option '(#\r "root") #t #f | |
302 | (lambda (opt name arg result) | |
303 | (alist-cons 'gc-root arg result))) | |
304 | (option '("log-file") #f #f | |
305 | (lambda (opt name arg result) | |
306 | (alist-cons 'log-file? #t result))) | |
7f3673f2 LC |
307 | (option '("with-source") #t #f |
308 | (lambda (opt name arg result) | |
309 | (alist-cons 'with-source arg result))) | |
05962f29 LC |
310 | (option '("no-grafts") #f #f |
311 | (lambda (opt name arg result) | |
312 | (alist-cons 'graft? #f | |
313 | (alist-delete 'graft? result eq?)))) | |
e7fc17b5 LC |
314 | |
315 | %standard-build-options)) | |
14a1c319 | 316 | |
81fa80b2 LC |
317 | (define (options->derivations store opts) |
318 | "Given OPTS, the result of 'args-fold', return a list of derivations to | |
319 | build." | |
320 | (define package->derivation | |
321 | (match (assoc-ref opts 'target) | |
322 | (#f package-derivation) | |
323 | (triplet | |
324 | (cut package-cross-derivation <> <> triplet <>)))) | |
325 | ||
2cdfe13d | 326 | (define src (assoc-ref opts 'source)) |
05962f29 LC |
327 | (define sys (assoc-ref opts 'system)) |
328 | (define graft? (assoc-ref opts 'graft?)) | |
81fa80b2 | 329 | |
05962f29 LC |
330 | (parameterize ((%graft? graft?)) |
331 | (let ((opts (options/with-source store | |
332 | (options/resolve-packages store opts)))) | |
2cdfe13d EB |
333 | (concatenate |
334 | (filter-map (match-lambda | |
335 | (('argument . (? package? p)) | |
336 | (match src | |
337 | (#f | |
338 | (list (package->derivation store p sys))) | |
339 | (#t | |
05962f29 | 340 | (let ((s (package-source p))) |
2cdfe13d EB |
341 | (list (package-source-derivation store s)))) |
342 | (proc | |
343 | (map (cut package-source-derivation store <>) | |
344 | (proc p))))) | |
345 | (('argument . (? derivation? drv)) | |
346 | (list drv)) | |
347 | (('argument . (? derivation-path? drv)) | |
348 | (list (call-with-input-file drv read-derivation))) | |
349 | (('argument . (? store-path?)) | |
350 | ;; Nothing to do; maybe for --log-file. | |
351 | #f) | |
352 | (_ #f)) | |
353 | opts))))) | |
7f3673f2 | 354 | |
257b9341 | 355 | (define (options/resolve-packages store opts) |
7f3673f2 LC |
356 | "Return OPTS with package specification strings replaced by actual |
357 | packages." | |
257b9341 LC |
358 | (define system |
359 | (or (assoc-ref opts 'system) (%current-system))) | |
360 | ||
7f3673f2 LC |
361 | (map (match-lambda |
362 | (('argument . (? string? spec)) | |
363 | (if (store-path? spec) | |
364 | `(argument . ,spec) | |
365 | `(argument . ,(specification->package spec)))) | |
257b9341 LC |
366 | (('expression . str) |
367 | (match (read/eval str) | |
368 | ((? package? p) | |
369 | `(argument . ,p)) | |
370 | ((? procedure? proc) | |
e87f0591 LC |
371 | (let ((drv (run-with-store store |
372 | (mbegin %store-monad | |
373 | (set-guile-for-build (default-guile)) | |
374 | (proc)) | |
375 | #:system system))) | |
56b82106 LC |
376 | `(argument . ,drv))) |
377 | ((? gexp? gexp) | |
378 | (let ((drv (run-with-store store | |
e87f0591 LC |
379 | (mbegin %store-monad |
380 | (set-guile-for-build (default-guile)) | |
381 | (gexp->derivation "gexp" gexp | |
382 | #:system system))))) | |
257b9341 | 383 | `(argument . ,drv))))) |
7f3673f2 LC |
384 | (opt opt)) |
385 | opts)) | |
386 | ||
387 | (define (options/with-source store opts) | |
388 | "Process with 'with-source' options in OPTS, replacing the relevant package | |
389 | arguments with packages that use the specified source." | |
390 | (define new-sources | |
391 | (filter-map (match-lambda | |
392 | (('with-source . uri) | |
393 | (cons (package-name->name+version (basename uri)) | |
394 | uri)) | |
395 | (_ #f)) | |
396 | opts)) | |
397 | ||
398 | (let loop ((opts opts) | |
399 | (sources new-sources) | |
400 | (result '())) | |
401 | (match opts | |
402 | (() | |
403 | (unless (null? sources) | |
404 | (warning (_ "sources do not match any package:~{ ~a~}~%") | |
405 | (match sources | |
406 | (((name . uri) ...) | |
407 | uri)))) | |
408 | (reverse result)) | |
409 | ((('argument . (? package? p)) tail ...) | |
410 | (let ((source (assoc-ref sources (package-name p)))) | |
411 | (loop tail | |
412 | (alist-delete (package-name p) sources) | |
413 | (alist-cons 'argument | |
414 | (if source | |
415 | (package-with-source store p source) | |
416 | p) | |
417 | result)))) | |
418 | ((('with-source . _) tail ...) | |
419 | (loop tail sources result)) | |
420 | ((head tail ...) | |
421 | (loop tail sources (cons head result)))))) | |
81fa80b2 | 422 | |
14a1c319 LC |
423 | \f |
424 | ;;; | |
425 | ;;; Entry point. | |
426 | ;;; | |
427 | ||
428 | (define (guix-build . args) | |
073c34d7 | 429 | (with-error-handling |
bf421152 LC |
430 | ;; Ask for absolute file names so that .drv file names passed from the |
431 | ;; user to 'read-derivation' are absolute when it returns. | |
432 | (with-fluids ((%file-port-name-canonicalization 'absolute)) | |
b3f21389 LC |
433 | (let* ((opts (parse-command-line args %options |
434 | (list %default-options))) | |
81fa80b2 LC |
435 | (store (open-connection)) |
436 | (drv (options->derivations store opts)) | |
437 | (roots (filter-map (match-lambda | |
438 | (('gc-root . root) root) | |
439 | (_ #f)) | |
440 | opts))) | |
9bb2b96a | 441 | |
e7fc17b5 | 442 | (set-build-options-from-command-line store opts) |
bdff90a1 LC |
443 | (unless (assoc-ref opts 'log-file?) |
444 | (show-what-to-build store drv | |
445 | #:use-substitutes? (assoc-ref opts 'substitutes?) | |
446 | #:dry-run? (assoc-ref opts 'dry-run?))) | |
447 | ||
81fa80b2 LC |
448 | (cond ((assoc-ref opts 'log-file?) |
449 | (for-each (lambda (file) | |
450 | (let ((log (log-file store file))) | |
451 | (if log | |
452 | (format #t "~a~%" log) | |
453 | (leave (_ "no build log for '~a'~%") | |
454 | file)))) | |
455 | (delete-duplicates | |
456 | (append (map derivation-file-name drv) | |
457 | (filter-map (match-lambda | |
458 | (('argument | |
459 | . (? store-path? file)) | |
460 | file) | |
461 | (_ #f)) | |
462 | opts))))) | |
463 | ((assoc-ref opts 'derivations-only?) | |
464 | (format #t "~{~a~%~}" (map derivation-file-name drv)) | |
465 | (for-each (cut register-root store <> <>) | |
466 | (map (compose list derivation-file-name) drv) | |
467 | roots)) | |
468 | ((not (assoc-ref opts 'dry-run?)) | |
469 | (and (build-derivations store drv) | |
470 | (for-each (lambda (d) | |
471 | (format #t "~{~a~%~}" | |
472 | (map (match-lambda | |
473 | ((out-name . out) | |
474 | (derivation->output-path | |
475 | d out-name))) | |
476 | (derivation-outputs d)))) | |
477 | drv) | |
478 | (for-each (cut register-root store <> <>) | |
479 | (map (lambda (drv) | |
480 | (map cdr | |
481 | (derivation->output-paths drv))) | |
482 | drv) | |
483 | roots)))))))) |