| blob | 7a5c3bca94ba48f0c1a5a3ccbc2c7d178bccca28 |
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.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/>.
20 (define-module (guix derivations)
21 #:use-module (srfi srfi-1)
22 #:use-module (srfi srfi-9)
23 #:use-module (srfi srfi-9 gnu)
24 #:use-module (srfi srfi-26)
25 #:use-module (srfi srfi-34)
26 #:use-module (srfi srfi-35)
27 #:use-module (ice-9 binary-ports)
28 #:use-module (rnrs bytevectors)
29 #:use-module (ice-9 match)
30 #:use-module (ice-9 rdelim)
31 #:use-module (ice-9 vlist)
32 #:use-module (guix store)
33 #:use-module (guix utils)
34 #:use-module (guix base16)
35 #:use-module (guix memoization)
36 #:use-module (guix combinators)
37 #:use-module (guix monads)
38 #:use-module (gcrypt hash)
39 #:use-module (guix base32)
40 #:use-module (guix records)
41 #:use-module (guix sets)
42 #:export (<derivation>
43 derivation?
44 derivation-outputs
45 derivation-inputs
46 derivation-sources
47 derivation-system
48 derivation-builder
49 derivation-builder-arguments
50 derivation-builder-environment-vars
51 derivation-file-name
52 derivation-prerequisites
53 derivation-prerequisites-to-build
55 <derivation-output>
56 derivation-output?
57 derivation-output-path
58 derivation-output-hash-algo
59 derivation-output-hash
60 derivation-output-recursive?
62 <derivation-input>
63 derivation-input?
64 derivation-input-path
65 derivation-input-sub-derivations
66 derivation-input-output-paths
67 valid-derivation-input?
69 &derivation-error
70 derivation-error?
71 derivation-error-derivation
72 &derivation-missing-output-error
73 derivation-missing-output-error?
74 derivation-missing-output
76 derivation-name
77 derivation-output-names
78 fixed-output-derivation?
79 offloadable-derivation?
80 substitutable-derivation?
81 substitution-oracle
82 derivation-hash
83 derivation-properties
85 read-derivation
86 read-derivation-from-file
87 write-derivation
88 derivation->output-path
89 derivation->output-paths
90 derivation-path->output-path
91 derivation-path->output-paths
92 derivation
93 raw-derivation
94 invalidate-derivation-caches!
96 map-derivation
98 build-derivations
99 built-derivations
101 file-search-error?
102 file-search-error-file-name
103 file-search-error-search-path
105 search-path*
106 module->source-file-name
107 build-expression->derivation)
109 ;; Re-export it from here for backward compatibility.
110 #:re-export (%guile-for-build))
112 ;;;
113 ;;; Error conditions.
114 ;;;
116 (define-condition-type &derivation-error &store-error
117 derivation-error?
118 (derivation derivation-error-derivation))
120 (define-condition-type &derivation-missing-output-error &derivation-error
121 derivation-missing-output-error?
122 (output derivation-missing-output))
124 ;;;
125 ;;; Nix derivations, as implemented in Nix's `derivations.cc'.
126 ;;;
128 (define-immutable-record-type <derivation>
129 (make-derivation outputs inputs sources system builder args env-vars
130 file-name)
131 derivation?
132 (outputs derivation-outputs) ; list of name/<derivation-output> pairs
133 (inputs derivation-inputs) ; list of <derivation-input>
134 (sources derivation-sources) ; list of store paths
135 (system derivation-system) ; string
136 (builder derivation-builder) ; store path
137 (args derivation-builder-arguments) ; list of strings
138 (env-vars derivation-builder-environment-vars) ; list of name/value pairs
139 (file-name derivation-file-name)) ; the .drv file name
141 (define-immutable-record-type <derivation-output>
142 (make-derivation-output path hash-algo hash recursive?)
143 derivation-output?
144 (path derivation-output-path) ; store path
145 (hash-algo derivation-output-hash-algo) ; symbol | #f
146 (hash derivation-output-hash) ; bytevector | #f
147 (recursive? derivation-output-recursive?)) ; Boolean
149 (define-immutable-record-type <derivation-input>
150 (make-derivation-input path sub-derivations)
151 derivation-input?
152 (path derivation-input-path) ; store path
153 (sub-derivations derivation-input-sub-derivations)) ; list of strings
155 (set-record-type-printer! <derivation>
156 (lambda (drv port)
157 (format port "#<derivation ~a => ~a ~a>"
158 (derivation-file-name drv)
159 (string-join
160 (map (match-lambda
161 ((_ . output)
162 (derivation-output-path output)))
163 (derivation-outputs drv)))
164 (number->string (object-address drv) 16))))
166 (define (derivation-name drv)
167 "Return the base name of DRV."
168 (let ((base (store-path-package-name (derivation-file-name drv))))
169 (string-drop-right base 4)))
171 (define (derivation-output-names drv)
172 "Return the names of the outputs of DRV."
173 (match (derivation-outputs drv)
174 (((names . _) ...)
175 names)))
177 (define (fixed-output-derivation? drv)
178 "Return #t if DRV is a fixed-output derivation, such as the result of a
179 download with a fixed hash (aka. `fetchurl')."
180 (match drv
181 (($ <derivation>
182 (("out" . ($ <derivation-output> _ (? symbol?) (? bytevector?)))))
183 #t)
184 (_ #f)))
186 (define (derivation-input<? input1 input2)
187 "Compare INPUT1 and INPUT2, two <derivation-input>."
188 (string<? (derivation-input-path input1)
189 (derivation-input-path input2)))
191 (define (derivation-input-output-paths input)
192 "Return the list of output paths corresponding to INPUT, a
193 <derivation-input>."
194 (match input
195 (($ <derivation-input> path sub-drvs)
196 (map (cut derivation-path->output-path path <>)
197 sub-drvs))))
199 (define (valid-derivation-input? store input)
200 "Return true if INPUT is valid--i.e., if all the outputs it requests are in
201 the store."
202 (every (cut valid-path? store <>)
203 (derivation-input-output-paths input)))
205 (define (coalesce-duplicate-inputs inputs)
206 "Return a list of inputs, such that when INPUTS contains the same DRV twice,
207 they are coalesced, with their sub-derivations merged. This is needed because
208 Nix itself keeps only one of them."
209 (fold (lambda (input result)
210 (match input
211 (($ <derivation-input> path sub-drvs)
212 ;; XXX: quadratic
213 (match (find (match-lambda
214 (($ <derivation-input> p s)
215 (string=? p path)))
216 result)
217 (#f
218 (cons input result))
219 ((and dup ($ <derivation-input> _ sub-drvs2))
220 ;; Merge DUP with INPUT.
221 (let ((sub-drvs (delete-duplicates
222 (append sub-drvs sub-drvs2))))
223 (cons (make-derivation-input path
224 (sort sub-drvs string<?))
225 (delq dup result))))))))
226 '()
227 inputs))
229 (define* (derivation-prerequisites drv #:optional (cut? (const #f)))
230 "Return the list of derivation-inputs required to build DRV, recursively.
232 CUT? is a predicate that is passed a derivation-input and returns true to
233 eliminate the given input and its dependencies from the search. An example of
234 such a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
235 result is the set of prerequisites of DRV not already in valid."
236 (let loop ((drv drv)
237 (result '())
238 (input-set (set)))
239 (let ((inputs (remove (lambda (input)
240 (or (set-contains? input-set input)
241 (cut? input)))
242 (derivation-inputs drv))))
243 (fold2 loop
244 (append inputs result)
245 (fold set-insert input-set inputs)
246 (map (lambda (i)
247 (read-derivation-from-file (derivation-input-path i)))
248 inputs)))))
250 (define (offloadable-derivation? drv)
251 "Return true if DRV can be offloaded, false otherwise."
252 (match (assoc "preferLocalBuild"
253 (derivation-builder-environment-vars drv))
254 (("preferLocalBuild" . "1") #f)
255 (_ #t)))
257 (define (substitutable-derivation? drv)
258 "Return #t if DRV can be substituted."
259 (match (assoc "allowSubstitutes"
260 (derivation-builder-environment-vars drv))
261 (("allowSubstitutes" . value)
262 (string=? value "1"))
263 (_ #t)))
265 (define (derivation-output-paths drv sub-drvs)
266 "Return the output paths of outputs SUB-DRVS of DRV."
267 (match drv
268 (($ <derivation> outputs)
269 (map (lambda (sub-drv)
270 (derivation-output-path (assoc-ref outputs sub-drv)))
271 sub-drvs))))
273 (define* (substitution-oracle store drv
274 #:key (mode (build-mode normal)))
275 "Return a one-argument procedure that, when passed a store file name,
276 returns a 'substitutable?' if it's substitutable and #f otherwise.
277 The returned procedure
278 knows about all substitutes for all the derivations listed in DRV, *except*
279 those that are already valid (that is, it won't bother checking whether an
280 item is substitutable if it's already on disk); it also knows about their
281 prerequisites, unless they are themselves substitutable.
283 Creating a single oracle (thus making a single 'substitutable-path-info' call) and
284 reusing it is much more efficient than calling 'has-substitutes?' or similar
285 repeatedly, because it avoids the costs associated with launching the
286 substituter many times."
287 (define valid?
288 (cut valid-path? store <>))
290 (define valid-input?
291 (cut valid-derivation-input? store <>))
293 (define (dependencies drv)
294 ;; Skip prerequisite sub-trees of DRV whose root is valid. This allows us
295 ;; to ask the substituter for just as much as needed, instead of asking it
296 ;; for the whole world, which can be significantly faster when substitute
297 ;; info is not already in cache.
298 ;; Also, skip derivations marked as non-substitutable.
299 (append-map (lambda (input)
300 (let ((drv (read-derivation-from-file
301 (derivation-input-path input))))
302 (if (substitutable-derivation? drv)
303 (derivation-input-output-paths input)
304 '())))
305 (derivation-prerequisites drv valid-input?)))
307 (let* ((paths (delete-duplicates
308 (concatenate
309 (fold (lambda (drv result)
310 (let ((self (match (derivation->output-paths drv)
311 (((names . paths) ...)
312 paths))))
313 (cond ((eqv? mode (build-mode check))
314 (cons (dependencies drv) result))
315 ((not (substitutable-derivation? drv))
316 (cons (dependencies drv) result))
317 ((every valid? self)
318 result)
319 (else
320 (cons* self (dependencies drv) result)))))
321 '()
322 drv))))
323 (subst (fold (lambda (subst vhash)
324 (vhash-cons (substitutable-path subst) subst
325 vhash))
326 vlist-null
327 (substitutable-path-info store paths))))
328 (lambda (item)
329 (match (vhash-assoc item subst)
330 (#f #f)
331 ((key . value) value)))))
333 (define* (derivation-prerequisites-to-build store drv
334 #:key
335 (mode (build-mode normal))
336 (outputs
337 (derivation-output-names drv))
338 (substitutable-info
339 (substitution-oracle store
340 (list drv)
341 #:mode mode)))
342 "Return two values: the list of derivation-inputs required to build the
343 OUTPUTS of DRV and not already available in STORE, recursively, and the list
344 of required store paths that can be substituted. SUBSTITUTABLE-INFO must be a
345 one-argument procedure similar to that returned by 'substitution-oracle'."
346 (define built?
347 (mlambda (item)
348 (valid-path? store item)))
350 (define input-built?
351 (compose (cut any built? <>) derivation-input-output-paths))
353 (define input-substitutable?
354 ;; Return true if and only if all of SUB-DRVS are subsitutable. If at
355 ;; least one is missing, then everything must be rebuilt.
356 (compose (cut every substitutable-info <>) derivation-input-output-paths))
358 (define (derivation-built? drv* sub-drvs)
359 ;; In 'check' mode, assume that DRV is not built.
360 (and (not (and (eqv? mode (build-mode check))
361 (eq? drv* drv)))
362 (every built? (derivation-output-paths drv* sub-drvs))))
364 (define (derivation-substitutable-info drv sub-drvs)
365 (and (substitutable-derivation? drv)
366 (let ((info (filter-map substitutable-info
367 (derivation-output-paths drv sub-drvs))))
368 (and (= (length info) (length sub-drvs))
369 info))))
371 (let loop ((drv drv)
372 (sub-drvs outputs)
373 (build '()) ;list of <derivation-input>
374 (substitute '())) ;list of <substitutable>
375 (cond ((derivation-built? drv sub-drvs)
376 (values build substitute))
377 ((derivation-substitutable-info drv sub-drvs)
378 =>
379 (lambda (substitutables)
380 (values build
381 (append substitutables substitute))))
382 (else
383 (let ((build (if (substitutable-derivation? drv)
384 build
385 (cons (make-derivation-input
386 (derivation-file-name drv) sub-drvs)
387 build)))
388 (inputs (remove (lambda (i)
389 (or (member i build) ; XXX: quadratic
390 (input-built? i)
391 (input-substitutable? i)))
392 (derivation-inputs drv))))
393 (fold2 loop
394 (append inputs build)
395 (append (append-map (lambda (input)
396 (if (and (not (input-built? input))
397 (input-substitutable? input))
398 (map substitutable-info
399 (derivation-input-output-paths
400 input))
401 '()))
402 (derivation-inputs drv))
403 substitute)
404 (map (lambda (i)
405 (read-derivation-from-file
406 (derivation-input-path i)))
407 inputs)
408 (map derivation-input-sub-derivations inputs)))))))
410 (define (read-derivation drv-port)
411 "Read the derivation from DRV-PORT and return the corresponding <derivation>
412 object. Most of the time you'll want to use 'read-derivation-from-file',
413 which caches things as appropriate and is thus more efficient."
415 (define comma (string->symbol ","))
417 (define (ununquote x)
418 (match x
419 (('unquote x) (ununquote x))
420 ((x ...) (map ununquote x))
421 (_ x)))
423 (define (outputs->alist x)
424 (fold-right (lambda (output result)
425 (match output
426 ((name path "" "")
427 (alist-cons name
428 (make-derivation-output path #f #f #f)
429 result))
430 ((name path hash-algo hash)
431 ;; fixed-output
432 (let* ((rec? (string-prefix? "r:" hash-algo))
433 (algo (string->symbol
434 (if rec?
435 (string-drop hash-algo 2)
436 hash-algo)))
437 (hash (base16-string->bytevector hash)))
438 (alist-cons name
439 (make-derivation-output path algo
440 hash rec?)
441 result)))))
442 '()
443 x))
445 (define (make-input-drvs x)
446 (fold-right (lambda (input result)
447 (match input
448 ((path (sub-drvs ...))
449 (cons (make-derivation-input path sub-drvs)
450 result))))
451 '()
452 x))
454 ;; The contents of a derivation are typically ASCII, but choosing
455 ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
456 (set-port-encoding! drv-port "UTF-8")
458 (let loop ((exp (read drv-port))
459 (result '()))
460 (match exp
461 ((? eof-object?)
462 (let ((result (reverse result)))
463 (match result
464 (('Derive ((outputs ...) (input-drvs ...)
465 (input-srcs ...)
466 (? string? system)
467 (? string? builder)
468 ((? string? args) ...)
469 ((var value) ...)))
470 (make-derivation (outputs->alist outputs)
471 (make-input-drvs input-drvs)
472 input-srcs
473 system builder args
474 (fold-right alist-cons '() var value)
475 (port-filename drv-port)))
476 (_
477 (error "failed to parse derivation" drv-port result)))))
478 ((? (cut eq? <> comma))
479 (loop (read drv-port) result))
480 (_
481 (loop (read drv-port)
482 (cons (ununquote exp) result))))))
484 (define %derivation-cache
485 ;; Maps derivation file names to <derivation> objects.
486 ;; XXX: This is redundant with 'atts-cache' in the store.
487 (make-weak-value-hash-table 200))
489 (define (read-derivation-from-file file)
490 "Read the derivation in FILE, a '.drv' file, and return the corresponding
491 <derivation> object."
492 ;; Memoize that operation because 'read-derivation' is quite expensive,
493 ;; and because the same argument is read more than 15 times on average
494 ;; during something like (package-derivation s gdb).
495 (or (and file (hash-ref %derivation-cache file))
496 (let ((drv (call-with-input-file file read-derivation)))
497 (hash-set! %derivation-cache file drv)
498 drv)))
500 (define-inlinable (write-sequence lst write-item port)
501 ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
502 ;; comma.
503 (match lst
504 (()
505 #t)
506 ((prefix (... ...) last)
507 (for-each (lambda (item)
508 (write-item item port)
509 (display "," port))
510 prefix)
511 (write-item last port))))
513 (define-inlinable (write-list lst write-item port)
514 ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
515 ;; element.
516 (display "[" port)
517 (write-sequence lst write-item port)
518 (display "]" port))
520 (define-inlinable (write-tuple lst write-item port)
521 ;; Same, but write LST as a tuple.
522 (display "(" port)
523 (write-sequence lst write-item port)
524 (display ")" port))
526 (define (write-derivation drv port)
527 "Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of
528 Eelco Dolstra's PhD dissertation for an overview of a previous version of
529 that form."
531 ;; Make sure we're using the faster implementation.
532 (define format simple-format)
534 (define (write-string-list lst)
535 (write-list lst write port))
537 (define (write-output output port)
538 (match output
539 ((name . ($ <derivation-output> path hash-algo hash recursive?))
540 (write-tuple (list name path
541 (if hash-algo
542 (string-append (if recursive? "r:" "")
543 (symbol->string hash-algo))
544 "")
545 (or (and=> hash bytevector->base16-string)
546 ""))
547 write
548 port))))
550 (define (write-input input port)
551 (match input
552 (($ <derivation-input> path sub-drvs)
553 (display "(\"" port)
554 (display path port)
555 (display "\"," port)
556 (write-string-list sub-drvs)
557 (display ")" port))))
559 (define (write-env-var env-var port)
560 (match env-var
561 ((name . value)
562 (display "(" port)
563 (write name port)
564 (display "," port)
565 (write value port)
566 (display ")" port))))
568 ;; Assume all the lists we are writing are already sorted.
569 (match drv
570 (($ <derivation> outputs inputs sources
571 system builder args env-vars)
572 (display "Derive(" port)
573 (write-list outputs write-output port)
574 (display "," port)
575 (write-list inputs write-input port)
576 (display "," port)
577 (write-string-list sources)
578 (simple-format port ",\"~a\",\"~a\"," system builder)
579 (write-string-list args)
580 (display "," port)
581 (write-list env-vars write-env-var port)
582 (display ")" port))))
584 (define derivation->bytevector
585 (mlambda (drv)
586 "Return the external representation of DRV as a UTF-8-encoded string."
587 (with-fluids ((%default-port-encoding "UTF-8"))
588 (call-with-values open-bytevector-output-port
589 (lambda (port get-bytevector)
590 (write-derivation drv port)
591 (get-bytevector))))))
593 (define* (derivation->output-path drv #:optional (output "out"))
594 "Return the store path of its output OUTPUT. Raise a
595 '&derivation-missing-output-error' condition if OUTPUT is not an output of
596 DRV."
597 (let ((output* (assoc-ref (derivation-outputs drv) output)))
598 (if output*
599 (derivation-output-path output*)
600 (raise (condition (&derivation-missing-output-error
601 (derivation drv)
602 (output output)))))))
604 (define (derivation->output-paths drv)
605 "Return the list of name/path pairs of the outputs of DRV."
606 (map (match-lambda
607 ((name . output)
608 (cons name (derivation-output-path output))))
609 (derivation-outputs drv)))
611 (define derivation-path->output-path
612 ;; This procedure is called frequently, so memoize it.
613 (let ((memoized (mlambda (path output)
614 (derivation->output-path (read-derivation-from-file path)
615 output))))
616 (lambda* (path #:optional (output "out"))
617 "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
618 path of its output OUTPUT."
619 (memoized path output))))
621 (define (derivation-path->output-paths path)
622 "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
623 list of name/path pairs of its outputs."
624 (derivation->output-paths (read-derivation-from-file path)))
626 \f
627 ;;;
628 ;;; Derivation primitive.
629 ;;;
631 (define derivation-path->base16-hash
632 (mlambda (file)
633 "Return a string containing the base16 representation of the hash of the
634 derivation at FILE."
635 (bytevector->base16-string
636 (derivation-hash (read-derivation-from-file file)))))
638 (define (derivation/masked-inputs drv)
639 "Assuming DRV is a regular derivation (not fixed-output), replace the file
640 name of each input with that input's hash."
641 (match drv
642 (($ <derivation> outputs inputs sources
643 system builder args env-vars)
644 (let ((inputs (map (match-lambda
645 (($ <derivation-input> path sub-drvs)
646 (let ((hash (derivation-path->base16-hash path)))
647 (make-derivation-input hash sub-drvs))))
648 inputs)))
649 (make-derivation outputs
650 (sort (coalesce-duplicate-inputs inputs)
651 derivation-input<?)
652 sources
653 system builder args env-vars
654 #f)))))
656 (define derivation-hash ; `hashDerivationModulo' in derivations.cc
657 (lambda (drv)
658 "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
659 (match drv
660 (($ <derivation> ((_ . ($ <derivation-output> path
661 (? symbol? hash-algo) (? bytevector? hash)
662 (? boolean? recursive?)))))
663 ;; A fixed-output derivation.
664 (sha256
665 (string->utf8
666 (string-append "fixed:out:"
667 (if recursive? "r:" "")
668 (symbol->string hash-algo)
669 ":" (bytevector->base16-string hash)
670 ":" path))))
671 (_
673 ;; XXX: At this point this remains faster than `port-sha256', because
674 ;; the SHA256 port's `write' method gets called for every single
675 ;; character.
676 (sha256 (derivation->bytevector (derivation/masked-inputs drv)))))))
678 (define* (derivation store name builder args
679 #:key
680 (system (%current-system)) (env-vars '())
681 (inputs '()) (outputs '("out"))
682 hash hash-algo recursive?
683 references-graphs
684 allowed-references disallowed-references
685 leaked-env-vars local-build?
686 (substitutable? #t)
687 (properties '()))
688 "Build a derivation with the given arguments, and return the resulting
689 <derivation> object. When HASH and HASH-ALGO are given, a
690 fixed-output derivation is created---i.e., one whose result is known in
691 advance, such as a file download. If, in addition, RECURSIVE? is true, then
692 that fixed output may be an executable file or a directory and HASH must be
693 the hash of an archive containing this output.
695 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
696 pairs. In that case, the reference graph of each store path is exported in
697 the build environment in the corresponding file, in a simple text format.
699 When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
700 that the derivation's outputs may refer to. Likewise, DISALLOWED-REFERENCES,
701 if true, must be a list of things the outputs may not refer to.
703 When LEAKED-ENV-VARS is true, it must be a list of strings denoting
704 environment variables that are allowed to \"leak\" from the daemon's
705 environment to the build environment. This is only applicable to fixed-output
706 derivations--i.e., when HASH is true. The main use is to allow variables such
707 as \"http_proxy\" to be passed to derivations that download files.
709 When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
710 for offloading and should rather be built locally. This is the case for small
711 derivations where the costs of data transfers would outweigh the benefits.
713 When SUBSTITUTABLE? is false, declare that substitutes of the derivation's
714 output should not be used.
716 PROPERTIES must be an association list describing \"properties\" of the
717 derivation. It is kept as-is, uninterpreted, in the derivation."
718 (define (add-output-paths drv)
719 ;; Return DRV with an actual store path for each of its output and the
720 ;; corresponding environment variable.
721 (match drv
722 (($ <derivation> outputs inputs sources
723 system builder args env-vars)
724 (let* ((drv-hash (derivation-hash drv))
725 (outputs (map (match-lambda
726 ((output-name . ($ <derivation-output>
727 _ algo hash rec?))
728 (let ((path
729 (if hash
730 (fixed-output-path name hash
731 #:hash-algo algo
732 #:output output-name
733 #:recursive? rec?)
734 (output-path output-name
735 drv-hash name))))
736 (cons output-name
737 (make-derivation-output path algo
738 hash rec?)))))
739 outputs)))
740 (make-derivation outputs inputs sources system builder args
741 (map (match-lambda
742 ((name . value)
743 (cons name
744 (or (and=> (assoc-ref outputs name)
745 derivation-output-path)
746 value))))
747 env-vars)
748 #f)))))
750 (define (user+system-env-vars)
751 ;; Some options are passed to the build daemon via the env. vars of
752 ;; derivations (urgh!). We hide that from our API, but here is the place
753 ;; where we kludgify those options.
754 (let ((env-vars `(,@(if local-build?
755 `(("preferLocalBuild" . "1"))
756 '())
757 ,@(if (not substitutable?)
758 `(("allowSubstitutes" . "0"))
759 '())
760 ,@(if allowed-references
761 `(("allowedReferences"
762 . ,(string-join allowed-references)))
763 '())
764 ,@(if disallowed-references
765 `(("disallowedReferences"
766 . ,(string-join disallowed-references)))
767 '())
768 ,@(if leaked-env-vars
769 `(("impureEnvVars"
770 . ,(string-join leaked-env-vars)))
771 '())
772 ,@(match properties
773 (() '())
774 (lst `(("guix properties"
775 . ,(object->string properties)))))
776 ,@env-vars)))
777 (match references-graphs
778 (((file . path) ...)
779 (let ((value (map (cut string-append <> " " <>)
780 file path)))
781 ;; XXX: This all breaks down if an element of FILE or PATH contains
782 ;; white space.
783 `(("exportReferencesGraph" . ,(string-join value " "))
784 ,@env-vars)))
785 (#f
786 env-vars))))
788 (define (env-vars-with-empty-outputs env-vars)
789 ;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
790 ;; empty string, even outputs that do not appear in ENV-VARS.
791 (let ((e (map (match-lambda
792 ((name . val)
793 (if (member name outputs)
794 (cons name "")
795 (cons name val))))
796 env-vars)))
797 (fold (lambda (output-name env-vars)
798 (if (assoc output-name env-vars)
799 env-vars
800 (append env-vars `((,output-name . "")))))
801 e
802 outputs)))
804 (define input->derivation-input
805 (match-lambda
806 (((? derivation? drv))
807 (make-derivation-input (derivation-file-name drv) '("out")))
808 (((? derivation? drv) sub-drvs ...)
809 (make-derivation-input (derivation-file-name drv) sub-drvs))
810 (((? direct-store-path? input))
811 (make-derivation-input input '("out")))
812 (((? direct-store-path? input) sub-drvs ...)
813 (make-derivation-input input sub-drvs))
814 ((input . _)
815 (let ((path (add-to-store store (basename input)
816 #t "sha256" input)))
817 (make-derivation-input path '())))))
819 ;; Note: lists are sorted alphabetically, to conform with the behavior of
820 ;; C++ `std::map' in Nix itself.
822 (let* ((outputs (map (lambda (name)
823 ;; Return outputs with an empty path.
824 (cons name
825 (make-derivation-output "" hash-algo
826 hash recursive?)))
827 (sort outputs string<?)))
828 (inputs (sort (coalesce-duplicate-inputs
829 (map input->derivation-input
830 (delete-duplicates inputs)))
831 derivation-input<?))
832 (env-vars (sort (env-vars-with-empty-outputs
833 (user+system-env-vars))
834 (lambda (e1 e2)
835 (string<? (car e1) (car e2)))))
836 (drv-masked (make-derivation outputs
837 (filter (compose derivation-path?
838 derivation-input-path)
839 inputs)
840 (filter-map (lambda (i)
841 (let ((p (derivation-input-path i)))
842 (and (not (derivation-path? p))
843 p)))
844 inputs)
845 system builder args env-vars #f))
846 (drv (add-output-paths drv-masked)))
848 (let* ((file (add-data-to-store store (string-append name ".drv")
849 (derivation->bytevector drv)
850 (map derivation-input-path inputs)))
851 (drv* (set-field drv (derivation-file-name) file)))
852 (hash-set! %derivation-cache file drv*)
853 drv*)))
855 (define (invalidate-derivation-caches!)
856 "Invalidate internal derivation caches. This is mostly useful for
857 long-running processes that know what they're doing. Use with care!"
858 ;; Typically this is meant to be used by Cuirass and Hydra, which can clear
859 ;; caches when they start evaluating packages for another architecture.
860 (invalidate-memoization! derivation->bytevector)
861 (invalidate-memoization! derivation-path->base16-hash)
862 (hash-clear! %derivation-cache))
864 (define derivation-properties
865 (mlambdaq (drv)
866 "Return the property alist associated with DRV."
867 (match (assoc "guix properties"
868 (derivation-builder-environment-vars drv))
869 ((_ . str) (call-with-input-string str read))
870 (#f '()))))
872 (define* (map-derivation store drv mapping
873 #:key (system (%current-system)))
874 "Given MAPPING, a list of pairs of derivations, return a derivation based on
875 DRV where all the 'car's of MAPPING have been replaced by its 'cdr's,
876 recursively."
877 (define (substitute str initial replacements)
878 (fold (lambda (path replacement result)
879 (string-replace-substring result path
880 replacement))
881 str
882 initial replacements))
884 (define (substitute-file file initial replacements)
885 (define contents
886 (with-fluids ((%default-port-encoding #f))
887 (call-with-input-file file read-string)))
889 (let ((updated (substitute contents initial replacements)))
890 (if (string=? updated contents)
891 file
892 ;; XXX: permissions aren't preserved.
893 (add-text-to-store store (store-path-package-name file)
894 updated))))
896 (define input->output-paths
897 (match-lambda
898 (((? derivation? drv))
899 (list (derivation->output-path drv)))
900 (((? derivation? drv) sub-drvs ...)
901 (map (cut derivation->output-path drv <>)
902 sub-drvs))
903 ((file)
904 (list file))))
906 (let ((mapping (fold (lambda (pair result)
907 (match pair
908 (((? derivation? orig) . replacement)
909 (vhash-cons (derivation-file-name orig)
910 replacement result))
911 ((file . replacement)
912 (vhash-cons file replacement result))))
913 vlist-null
914 mapping)))
915 (define rewritten-input
916 ;; Rewrite the given input according to MAPPING, and return an input
917 ;; in the format used in 'derivation' calls.
918 (mlambda (input loop)
919 (match input
920 (($ <derivation-input> path (sub-drvs ...))
921 (match (vhash-assoc path mapping)
922 ((_ . (? derivation? replacement))
923 (cons replacement sub-drvs))
924 ((_ . replacement)
925 (list replacement))
926 (#f
927 (let* ((drv (loop (read-derivation-from-file path))))
928 (cons drv sub-drvs))))))))
930 (let loop ((drv drv))
931 (let* ((inputs (map (cut rewritten-input <> loop)
932 (derivation-inputs drv)))
933 (initial (append-map derivation-input-output-paths
934 (derivation-inputs drv)))
935 (replacements (append-map input->output-paths inputs))
937 ;; Sources typically refer to the output directories of the
938 ;; original inputs, INITIAL. Rewrite them by substituting
939 ;; REPLACEMENTS.
940 (sources (map (lambda (source)
941 (match (vhash-assoc source mapping)
942 ((_ . replacement)
943 replacement)
944 (#f
945 (substitute-file source
946 initial replacements))))
947 (derivation-sources drv)))
949 ;; Now augment the lists of initials and replacements.
950 (initial (append (derivation-sources drv) initial))
951 (replacements (append sources replacements))
952 (name (store-path-package-name
953 (string-drop-right (derivation-file-name drv)
954 4))))
955 (derivation store name
956 (substitute (derivation-builder drv)
957 initial replacements)
958 (map (cut substitute <> initial replacements)
959 (derivation-builder-arguments drv))
960 #:system system
961 #:env-vars (map (match-lambda
962 ((var . value)
963 `(,var
964 . ,(substitute value initial
965 replacements))))
966 (derivation-builder-environment-vars drv))
967 #:inputs (append (map list sources) inputs)
968 #:outputs (derivation-output-names drv)
969 #:hash (match (derivation-outputs drv)
970 ((($ <derivation-output> _ algo hash))
971 hash)
972 (_ #f))
973 #:hash-algo (match (derivation-outputs drv)
974 ((($ <derivation-output> _ algo hash))
975 algo)
976 (_ #f)))))))
978 \f
979 ;;;
980 ;;; Store compatibility layer.
981 ;;;
983 (define* (build-derivations store derivations
984 #:optional (mode (build-mode normal)))
985 "Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
986 the specified MODE."
987 (build-things store (map (match-lambda
988 ((? string? file) file)
989 ((and drv ($ <derivation>))
990 (derivation-file-name drv)))
991 derivations)
992 mode))
994 \f
995 ;;;
996 ;;; Guile-based builders.
997 ;;;
999 (define (parent-directories file-name)
1000 "Return the list of parent dirs of FILE-NAME, in the order in which an
1001 `mkdir -p' implementation would make them."
1002 (let ((not-slash (char-set-complement (char-set #\/))))
1003 (reverse
1004 (fold (lambda (dir result)
1005 (match result
1006 (()
1007 (list dir))
1008 ((prev _ ...)
1009 (cons (string-append prev "/" dir)
1010 result))))
1011 '()
1012 (remove (cut string=? <> ".")
1013 (string-tokenize (dirname file-name) not-slash))))))
1015 (define* (imported-files store files ;deprecated
1016 #:key (name "file-import")
1017 (system (%current-system))
1018 (guile (%guile-for-build)))
1019 "Return a derivation that imports FILES into STORE. FILES must be a list
1020 of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
1021 system, imported, and appears under FINAL-PATH in the resulting store path."
1022 (let* ((files (map (match-lambda
1023 ((final-path . file-name)
1024 (list final-path
1025 (add-to-store store (basename final-path) #f
1026 "sha256" file-name))))
1027 files))
1028 (builder
1029 `(begin
1030 (mkdir %output) (chdir %output)
1031 ,@(append-map (match-lambda
1032 ((final-path store-path)
1033 (append (match (parent-directories final-path)
1034 (() '())
1035 ((head ... tail)
1036 (append (map (lambda (d)
1037 `(false-if-exception
1038 (mkdir ,d)))
1039 head)
1040 `((or (file-exists? ,tail)
1041 (mkdir ,tail))))))
1042 `((symlink ,store-path ,final-path)))))
1043 files))))
1044 (build-expression->derivation store name builder
1045 #:system system
1046 #:inputs files
1047 #:guile-for-build guile
1048 #:local-build? #t)))
1050 ;; The "file not found" error condition.
1051 (define-condition-type &file-search-error &error
1052 file-search-error?
1053 (file file-search-error-file-name)
1054 (path file-search-error-search-path))
1056 (define search-path*
1057 ;; A memoizing version of 'search-path' so 'imported-modules' does not end
1058 ;; up looking for the same files over and over again.
1059 (mlambda (path file)
1060 "Search for FILE in PATH and memoize the result. Raise a
1061 '&file-search-error' condition if it could not be found."
1062 (or (search-path path file)
1063 (raise (condition
1064 (&file-search-error (file file)
1065 (path path)))))))
1067 (define (module->source-file-name module)
1068 "Return the file name corresponding to MODULE, a Guile module name (a list
1069 of symbols.)"
1070 (string-append (string-join (map symbol->string module) "/")
1071 ".scm"))
1073 (define* (%imported-modules store modules ;deprecated
1074 #:key (name "module-import")
1075 (system (%current-system))
1076 (guile (%guile-for-build))
1077 (module-path %load-path))
1078 "Return a derivation that contains the source files of MODULES, a list of
1079 module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
1080 search path."
1081 ;; TODO: Determine the closure of MODULES, build the `.go' files,
1082 ;; canonicalize the source files through read/write, etc.
1083 (let ((files (map (lambda (m)
1084 (let ((f (module->source-file-name m)))
1085 (cons f (search-path* module-path f))))
1086 modules)))
1087 (imported-files store files #:name name #:system system
1088 #:guile guile)))
1090 (define* (%compiled-modules store modules ;deprecated
1091 #:key (name "module-import-compiled")
1092 (system (%current-system))
1093 (guile (%guile-for-build))
1094 (module-path %load-path))
1095 "Return a derivation that builds a tree containing the `.go' files
1096 corresponding to MODULES. All the MODULES are built in a context where
1097 they can refer to each other."
1098 (let* ((module-drv (%imported-modules store modules
1099 #:system system
1100 #:guile guile
1101 #:module-path module-path))
1102 (module-dir (derivation->output-path module-drv))
1103 (files (map (lambda (m)
1104 (let ((f (string-join (map symbol->string m)
1105 "/")))
1106 (cons (string-append f ".go")
1107 (string-append module-dir "/" f ".scm"))))
1108 modules)))
1109 (define builder
1110 `(begin
1111 (use-modules (system base compile))
1112 (let ((out (assoc-ref %outputs "out")))
1113 (mkdir out)
1114 (chdir out))
1116 (set! %load-path
1117 (cons ,module-dir %load-path))
1119 ,@(map (match-lambda
1120 ((output . input)
1121 (let ((make-parent-dirs (map (lambda (dir)
1122 `(unless (file-exists? ,dir)
1123 (mkdir ,dir)))
1124 (parent-directories output))))
1125 `(begin
1126 ,@make-parent-dirs
1127 (compile-file ,input
1128 #:output-file ,output
1129 #:opts %auto-compilation-options)))))
1130 files)))
1132 (build-expression->derivation store name builder
1133 #:inputs `(("modules" ,module-drv))
1134 #:system system
1135 #:guile-for-build guile
1136 #:local-build? #t)))
1138 (define* (build-expression->derivation store name exp ;deprecated
1139 #:key
1140 (system (%current-system))
1141 (inputs '())
1142 (outputs '("out"))
1143 hash hash-algo recursive?
1144 (env-vars '())
1145 (modules '())
1146 guile-for-build
1147 references-graphs
1148 allowed-references
1149 disallowed-references
1150 local-build? (substitutable? #t)
1151 (properties '()))
1152 "Return a derivation that executes Scheme expression EXP as a builder
1153 for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
1154 tuples; when SUB-DRV is omitted, \"out\" is assumed. MODULES is a list
1155 of names of Guile modules from the current search path to be copied in
1156 the store, compiled, and made available in the load path during the
1157 execution of EXP.
1159 EXP is evaluated in an environment where %OUTPUT is bound to the main
1160 output path, %OUTPUTS is bound to a list of output/path pairs, and where
1161 %BUILD-INPUTS is bound to an alist of string/output-path pairs made from
1162 INPUTS. Optionally, ENV-VARS is a list of string pairs specifying the
1163 name and value of environment variables visible to the builder. The
1164 builder terminates by passing the result of EXP to `exit'; thus, when
1165 EXP returns #f, the build is considered to have failed.
1167 EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
1168 omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
1170 See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
1171 ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, SUBSTITUTABLE?,
1172 and PROPERTIES."
1173 (define guile-drv
1174 (or guile-for-build (%guile-for-build)))
1176 (define guile
1177 (string-append (derivation->output-path guile-drv)
1178 "/bin/guile"))
1180 (define module-form?
1181 (match-lambda
1182 (((or 'define-module 'use-modules) _ ...) #t)
1183 (_ #f)))
1185 (define source-path
1186 ;; When passed an input that is a source, return its path; otherwise
1187 ;; return #f.
1188 (match-lambda
1189 ((_ (? derivation?) _ ...)
1190 #f)
1191 ((_ path _ ...)
1192 (and (not (derivation-path? path))
1193 path))))
1195 (let* ((prologue `(begin
1196 ,@(match exp
1197 ((_ ...)
1198 ;; Module forms must appear at the top-level so
1199 ;; that any macros they export can be expanded.
1200 (filter module-form? exp))
1201 (_ `(,exp)))
1203 (define %output (getenv "out"))
1204 (define %outputs
1205 (map (lambda (o)
1206 (cons o (getenv o)))
1207 ',outputs))
1208 (define %build-inputs
1209 ',(map (match-lambda
1210 ((name drv . rest)
1211 (let ((sub (match rest
1212 (() "out")
1213 ((x) x))))
1214 (cons name
1215 (cond
1216 ((derivation? drv)
1217 (derivation->output-path drv sub))
1218 ((derivation-path? drv)
1219 (derivation-path->output-path drv
1220 sub))
1221 (else drv))))))
1222 inputs))
1224 ,@(if (null? modules)
1225 '()
1226 ;; Remove our own settings.
1227 '((unsetenv "GUILE_LOAD_COMPILED_PATH")))
1229 ;; Guile sets it, but remove it to avoid conflicts when
1230 ;; building Guile-using packages.
1231 (unsetenv "LD_LIBRARY_PATH")))
1232 (builder (add-text-to-store store
1233 (string-append name "-guile-builder")
1235 ;; Explicitly use UTF-8 for determinism,
1236 ;; and also because UTF-8 output is faster.
1237 (with-fluids ((%default-port-encoding
1238 "UTF-8"))
1239 (call-with-output-string
1240 (lambda (port)
1241 (write prologue port)
1242 (write
1243 `(exit
1244 ,(match exp
1245 ((_ ...)
1246 (remove module-form? exp))
1247 (_ `(,exp))))
1248 port))))
1250 ;; The references don't really matter
1251 ;; since the builder is always used in
1252 ;; conjunction with the drv that needs
1253 ;; it. For clarity, we add references
1254 ;; to the subset of INPUTS that are
1255 ;; sources, avoiding references to other
1256 ;; .drv; otherwise, BUILDER's hash would
1257 ;; depend on those, even if they are
1258 ;; fixed-output.
1259 (filter-map source-path inputs)))
1261 (mod-drv (and (pair? modules)
1262 (%imported-modules store modules
1263 #:guile guile-drv
1264 #:system system)))
1265 (mod-dir (and mod-drv
1266 (derivation->output-path mod-drv)))
1267 (go-drv (and (pair? modules)
1268 (%compiled-modules store modules
1269 #:guile guile-drv
1270 #:system system)))
1271 (go-dir (and go-drv
1272 (derivation->output-path go-drv))))
1273 (derivation store name guile
1274 `("--no-auto-compile"
1275 ,@(if mod-dir `("-L" ,mod-dir) '())
1276 ,builder)
1278 #:system system
1280 #:inputs `((,(or guile-for-build (%guile-for-build)))
1281 (,builder)
1282 ,@(map cdr inputs)
1283 ,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
1285 ;; When MODULES is non-empty, shamelessly clobber
1286 ;; $GUILE_LOAD_COMPILED_PATH.
1287 #:env-vars (if go-dir
1288 `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
1289 ,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
1290 env-vars))
1291 env-vars)
1293 #:hash hash #:hash-algo hash-algo
1294 #:recursive? recursive?
1295 #:outputs outputs
1296 #:references-graphs references-graphs
1297 #:allowed-references allowed-references
1298 #:disallowed-references disallowed-references
1299 #:local-build? local-build?
1300 #:substitutable? substitutable?
1301 #:properties properties)))
1303 \f
1304 ;;;
1305 ;;; Monadic interface.
1306 ;;;
1308 (define built-derivations
1309 (store-lift build-derivations))
1311 (define raw-derivation
1312 (store-lift derivation))