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