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