Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
425b0bfc | 2 | ;;; Copyright © 2012, 2013, 2014 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) |
5e3b388b | 36 | #:autoload (gnu packages) (specification->package) |
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'." | |
609354bf | 102 | (display (_ " |
14a1c319 LC |
103 | -K, --keep-failed keep build tree of failed builds")) |
104 | (display (_ " | |
105 | -n, --dry-run do not build the derivations")) | |
56b1f4b7 LC |
106 | (display (_ " |
107 | --fallback fall back to building when the substituter fails")) | |
1c3972da | 108 | (display (_ " |
692c6c15 | 109 | --no-substitutes build instead of resorting to pre-built substitutes")) |
425b0bfc LC |
110 | (display (_ " |
111 | --no-build-hook do not attempt to offload builds via the build hook")) | |
969e678e LC |
112 | (display (_ " |
113 | --max-silent-time=SECONDS | |
114 | mark the build as failed after SECONDS of silence")) | |
002622b6 LC |
115 | (display (_ " |
116 | --timeout=SECONDS mark the build as failed after SECONDS of activity")) | |
07ab4bf1 LC |
117 | (display (_ " |
118 | --verbosity=LEVEL use the given verbosity LEVEL")) | |
bf421152 | 119 | (display (_ " |
e7fc17b5 | 120 | -c, --cores=N allow the use of up to N CPU cores for the build"))) |
14a1c319 | 121 | |
e7fc17b5 LC |
122 | (define (set-build-options-from-command-line store opts) |
123 | "Given OPTS, an alist as returned by 'args-fold' given | |
124 | '%standard-build-options', set the corresponding build options on STORE." | |
125 | ;; TODO: Add more options. | |
126 | (set-build-options store | |
127 | #:keep-failed? (assoc-ref opts 'keep-failed?) | |
128 | #:build-cores (or (assoc-ref opts 'cores) 0) | |
129 | #:fallback? (assoc-ref opts 'fallback?) | |
130 | #:use-substitutes? (assoc-ref opts 'substitutes?) | |
131 | #:use-build-hook? (assoc-ref opts 'build-hook?) | |
132 | #:max-silent-time (assoc-ref opts 'max-silent-time) | |
002622b6 | 133 | #:timeout (assoc-ref opts 'timeout) |
b6b097ac | 134 | #:print-build-trace (assoc-ref opts 'print-build-trace?) |
e7fc17b5 | 135 | #:verbosity (assoc-ref opts 'verbosity))) |
14a1c319 | 136 | |
e7fc17b5 LC |
137 | (define %standard-build-options |
138 | ;; List of standard command-line options for tools that build something. | |
139 | (list (option '(#\K "keep-failed") #f #f | |
dd67b429 LC |
140 | (lambda (opt name arg result . rest) |
141 | (apply values | |
142 | (alist-cons 'keep-failed? #t result) | |
143 | rest))) | |
56b1f4b7 | 144 | (option '("fallback") #f #f |
dd67b429 LC |
145 | (lambda (opt name arg result . rest) |
146 | (apply values | |
147 | (alist-cons 'fallback? #t | |
148 | (alist-delete 'fallback? result)) | |
149 | rest))) | |
692c6c15 | 150 | (option '("no-substitutes") #f #f |
dd67b429 LC |
151 | (lambda (opt name arg result . rest) |
152 | (apply values | |
153 | (alist-cons 'substitutes? #f | |
154 | (alist-delete 'substitutes? result)) | |
155 | rest))) | |
425b0bfc | 156 | (option '("no-build-hook") #f #f |
dd67b429 LC |
157 | (lambda (opt name arg result . rest) |
158 | (apply values | |
159 | (alist-cons 'build-hook? #f | |
160 | (alist-delete 'build-hook? result)) | |
161 | rest))) | |
969e678e | 162 | (option '("max-silent-time") #t #f |
dd67b429 LC |
163 | (lambda (opt name arg result . rest) |
164 | (apply values | |
165 | (alist-cons 'max-silent-time (string->number* arg) | |
166 | result) | |
167 | rest))) | |
002622b6 LC |
168 | (option '("timeout") #t #f |
169 | (lambda (opt name arg result . rest) | |
170 | (apply values | |
171 | (alist-cons 'timeout (string->number* arg) result) | |
172 | rest))) | |
07ab4bf1 | 173 | (option '("verbosity") #t #f |
dd67b429 | 174 | (lambda (opt name arg result . rest) |
07ab4bf1 | 175 | (let ((level (string->number arg))) |
dd67b429 LC |
176 | (apply values |
177 | (alist-cons 'verbosity level | |
178 | (alist-delete 'verbosity result)) | |
179 | rest)))) | |
e7fc17b5 | 180 | (option '(#\c "cores") #t #f |
dd67b429 | 181 | (lambda (opt name arg result . rest) |
e7fc17b5 LC |
182 | (let ((c (false-if-exception (string->number arg)))) |
183 | (if c | |
dd67b429 | 184 | (apply values (alist-cons 'cores c result) rest) |
e7fc17b5 LC |
185 | (leave (_ "~a: not a number~%") arg))))))) |
186 | ||
187 | \f | |
188 | ;;; | |
189 | ;;; Command-line options. | |
190 | ;;; | |
191 | ||
192 | (define %default-options | |
193 | ;; Alist of default option values. | |
194 | `((system . ,(%current-system)) | |
195 | (substitutes? . #t) | |
196 | (build-hook? . #t) | |
b6b097ac | 197 | (print-build-trace? . #t) |
e7fc17b5 LC |
198 | (max-silent-time . 3600) |
199 | (verbosity . 0))) | |
200 | ||
201 | (define (show-help) | |
202 | (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... | |
203 | Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) | |
204 | (display (_ " | |
205 | -e, --expression=EXPR build the package or derivation EXPR evaluates to")) | |
206 | (display (_ " | |
207 | -S, --source build the packages' source derivations")) | |
208 | (display (_ " | |
209 | -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) | |
210 | (display (_ " | |
211 | --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) | |
7f3673f2 LC |
212 | (display (_ " |
213 | --with-source=SOURCE | |
214 | use SOURCE when building the corresponding package")) | |
e7fc17b5 LC |
215 | (display (_ " |
216 | -d, --derivations return the derivation paths of the given packages")) | |
217 | (display (_ " | |
218 | -r, --root=FILE make FILE a symlink to the result, and register it | |
219 | as a garbage collector root")) | |
220 | (display (_ " | |
221 | --log-file return the log file names for the given derivations")) | |
222 | (newline) | |
223 | (show-build-options-help) | |
224 | (newline) | |
225 | (display (_ " | |
226 | -h, --help display this help and exit")) | |
227 | (display (_ " | |
228 | -V, --version display version information and exit")) | |
229 | (newline) | |
230 | (show-bug-report-information)) | |
231 | ||
232 | (define %options | |
233 | ;; Specifications of the command-line options. | |
234 | (cons* (option '(#\h "help") #f #f | |
235 | (lambda args | |
236 | (show-help) | |
237 | (exit 0))) | |
238 | (option '(#\V "version") #f #f | |
239 | (lambda args | |
240 | (show-version-and-exit "guix build"))) | |
241 | ||
242 | (option '(#\S "source") #f #f | |
243 | (lambda (opt name arg result) | |
244 | (alist-cons 'source? #t result))) | |
245 | (option '(#\s "system") #t #f | |
246 | (lambda (opt name arg result) | |
247 | (alist-cons 'system arg | |
248 | (alist-delete 'system result eq?)))) | |
249 | (option '("target") #t #f | |
250 | (lambda (opt name arg result) | |
251 | (alist-cons 'target arg | |
252 | (alist-delete 'target result eq?)))) | |
253 | (option '(#\d "derivations") #f #f | |
254 | (lambda (opt name arg result) | |
255 | (alist-cons 'derivations-only? #t result))) | |
256 | (option '(#\e "expression") #t #f | |
257 | (lambda (opt name arg result) | |
258 | (alist-cons 'expression arg result))) | |
259 | (option '(#\n "dry-run") #f #f | |
260 | (lambda (opt name arg result) | |
261 | (alist-cons 'dry-run? #t result))) | |
262 | (option '(#\r "root") #t #f | |
263 | (lambda (opt name arg result) | |
264 | (alist-cons 'gc-root arg result))) | |
265 | (option '("log-file") #f #f | |
266 | (lambda (opt name arg result) | |
267 | (alist-cons 'log-file? #t result))) | |
7f3673f2 LC |
268 | (option '("with-source") #t #f |
269 | (lambda (opt name arg result) | |
270 | (alist-cons 'with-source arg result))) | |
e7fc17b5 LC |
271 | |
272 | %standard-build-options)) | |
14a1c319 | 273 | |
81fa80b2 LC |
274 | (define (options->derivations store opts) |
275 | "Given OPTS, the result of 'args-fold', return a list of derivations to | |
276 | build." | |
277 | (define package->derivation | |
278 | (match (assoc-ref opts 'target) | |
279 | (#f package-derivation) | |
280 | (triplet | |
281 | (cut package-cross-derivation <> <> triplet <>)))) | |
282 | ||
283 | (define src? (assoc-ref opts 'source?)) | |
284 | (define sys (assoc-ref opts 'system)) | |
285 | ||
7f3673f2 | 286 | (let ((opts (options/with-source store |
257b9341 | 287 | (options/resolve-packages store opts)))) |
7f3673f2 | 288 | (filter-map (match-lambda |
7f3673f2 | 289 | (('argument . (? package? p)) |
81fa80b2 LC |
290 | (if src? |
291 | (let ((s (package-source p))) | |
292 | (package-source-derivation store s)) | |
7f3673f2 | 293 | (package->derivation store p sys))) |
257b9341 LC |
294 | (('argument . (? derivation? drv)) |
295 | drv) | |
7f3673f2 LC |
296 | (('argument . (? derivation-path? drv)) |
297 | (call-with-input-file drv read-derivation)) | |
298 | (('argument . (? store-path?)) | |
299 | ;; Nothing to do; maybe for --log-file. | |
300 | #f) | |
301 | (_ #f)) | |
302 | opts))) | |
303 | ||
257b9341 | 304 | (define (options/resolve-packages store opts) |
7f3673f2 LC |
305 | "Return OPTS with package specification strings replaced by actual |
306 | packages." | |
257b9341 LC |
307 | (define system |
308 | (or (assoc-ref opts 'system) (%current-system))) | |
309 | ||
7f3673f2 LC |
310 | (map (match-lambda |
311 | (('argument . (? string? spec)) | |
312 | (if (store-path? spec) | |
313 | `(argument . ,spec) | |
314 | `(argument . ,(specification->package spec)))) | |
257b9341 LC |
315 | (('expression . str) |
316 | (match (read/eval str) | |
317 | ((? package? p) | |
318 | `(argument . ,p)) | |
319 | ((? procedure? proc) | |
320 | (let ((drv (run-with-store store (proc) #:system system))) | |
56b82106 LC |
321 | `(argument . ,drv))) |
322 | ((? gexp? gexp) | |
323 | (let ((drv (run-with-store store | |
324 | (gexp->derivation "gexp" gexp | |
325 | #:system system)))) | |
257b9341 | 326 | `(argument . ,drv))))) |
7f3673f2 LC |
327 | (opt opt)) |
328 | opts)) | |
329 | ||
330 | (define (options/with-source store opts) | |
331 | "Process with 'with-source' options in OPTS, replacing the relevant package | |
332 | arguments with packages that use the specified source." | |
333 | (define new-sources | |
334 | (filter-map (match-lambda | |
335 | (('with-source . uri) | |
336 | (cons (package-name->name+version (basename uri)) | |
337 | uri)) | |
338 | (_ #f)) | |
339 | opts)) | |
340 | ||
341 | (let loop ((opts opts) | |
342 | (sources new-sources) | |
343 | (result '())) | |
344 | (match opts | |
345 | (() | |
346 | (unless (null? sources) | |
347 | (warning (_ "sources do not match any package:~{ ~a~}~%") | |
348 | (match sources | |
349 | (((name . uri) ...) | |
350 | uri)))) | |
351 | (reverse result)) | |
352 | ((('argument . (? package? p)) tail ...) | |
353 | (let ((source (assoc-ref sources (package-name p)))) | |
354 | (loop tail | |
355 | (alist-delete (package-name p) sources) | |
356 | (alist-cons 'argument | |
357 | (if source | |
358 | (package-with-source store p source) | |
359 | p) | |
360 | result)))) | |
361 | ((('with-source . _) tail ...) | |
362 | (loop tail sources result)) | |
363 | ((head tail ...) | |
364 | (loop tail sources (cons head result)))))) | |
81fa80b2 | 365 | |
14a1c319 LC |
366 | \f |
367 | ;;; | |
368 | ;;; Entry point. | |
369 | ;;; | |
370 | ||
371 | (define (guix-build . args) | |
fa14d96e LC |
372 | (define (parse-options) |
373 | ;; Return the alist of option values. | |
a5975ced LC |
374 | (args-fold* args %options |
375 | (lambda (opt name arg result) | |
376 | (leave (_ "~A: unrecognized option~%") name)) | |
377 | (lambda (arg result) | |
378 | (alist-cons 'argument arg result)) | |
379 | %default-options)) | |
fa14d96e | 380 | |
073c34d7 | 381 | (with-error-handling |
bf421152 LC |
382 | ;; Ask for absolute file names so that .drv file names passed from the |
383 | ;; user to 'read-derivation' are absolute when it returns. | |
384 | (with-fluids ((%file-port-name-canonicalization 'absolute)) | |
81fa80b2 LC |
385 | (let* ((opts (parse-options)) |
386 | (store (open-connection)) | |
387 | (drv (options->derivations store opts)) | |
388 | (roots (filter-map (match-lambda | |
389 | (('gc-root . root) root) | |
390 | (_ #f)) | |
391 | opts))) | |
9bb2b96a | 392 | |
e7fc17b5 | 393 | (set-build-options-from-command-line store opts) |
bdff90a1 LC |
394 | (unless (assoc-ref opts 'log-file?) |
395 | (show-what-to-build store drv | |
396 | #:use-substitutes? (assoc-ref opts 'substitutes?) | |
397 | #:dry-run? (assoc-ref opts 'dry-run?))) | |
398 | ||
81fa80b2 LC |
399 | (cond ((assoc-ref opts 'log-file?) |
400 | (for-each (lambda (file) | |
401 | (let ((log (log-file store file))) | |
402 | (if log | |
403 | (format #t "~a~%" log) | |
404 | (leave (_ "no build log for '~a'~%") | |
405 | file)))) | |
406 | (delete-duplicates | |
407 | (append (map derivation-file-name drv) | |
408 | (filter-map (match-lambda | |
409 | (('argument | |
410 | . (? store-path? file)) | |
411 | file) | |
412 | (_ #f)) | |
413 | opts))))) | |
414 | ((assoc-ref opts 'derivations-only?) | |
415 | (format #t "~{~a~%~}" (map derivation-file-name drv)) | |
416 | (for-each (cut register-root store <> <>) | |
417 | (map (compose list derivation-file-name) drv) | |
418 | roots)) | |
419 | ((not (assoc-ref opts 'dry-run?)) | |
420 | (and (build-derivations store drv) | |
421 | (for-each (lambda (d) | |
422 | (format #t "~{~a~%~}" | |
423 | (map (match-lambda | |
424 | ((out-name . out) | |
425 | (derivation->output-path | |
426 | d out-name))) | |
427 | (derivation-outputs d)))) | |
428 | drv) | |
429 | (for-each (cut register-root store <> <>) | |
430 | (map (lambda (drv) | |
431 | (map cdr | |
432 | (derivation->output-paths drv))) | |
433 | drv) | |
434 | roots)))))))) |