(zilch nix drv): add derivation metadata slot
This will be used to store information for CA derivation fallbacks, for e.g. handling header dependencies. Change-Id: I6a6a696467311fcfbb0f01fb13998153b0cc04a7
This commit is contained in:
parent
895fb39c76
commit
a2ec3ded0f
1 changed files with 57 additions and 48 deletions
|
|
@ -20,6 +20,8 @@
|
|||
derivation-input-src derivation-system derivation-builder
|
||||
derivation-args derivation-env derivation-equal?
|
||||
|
||||
derivation-meta set-derivation-meta!
|
||||
|
||||
derivation-serialize derivation-path-references derivation-path derivation-read read-drv-path
|
||||
make-fixed-output-derivation make-input-addressed-derivation make-impure-derivation make-ca-derivation
|
||||
modulo-hash-drv-contents)
|
||||
|
|
@ -62,27 +64,34 @@
|
|||
(+ (string-length (%store-dir)) 34 (string-length (derivation-name drv)) (if (string=? output-name "out") 0 (+ 1 (string-length output-name)))))
|
||||
|
||||
;; Internal use; stores the precalculated .drv path and modulo hash.
|
||||
(define-record-type <derivation-cached-data>
|
||||
(make-derivation-cached-data path modulo-hash is-deferred serialized)
|
||||
(define-record-type <derivation-metadata>
|
||||
(make-derivation-metadata path modulo-hash is-deferred serialized meta)
|
||||
derivation-cached-data?
|
||||
(path derivation-cached-data-path set-derivation-cached-data-path!)
|
||||
(modulo-hash derivation-cached-data-modulo-hash set-derivation-cached-data-modulo-hash!)
|
||||
(is-deferred derivation-cached-data-is-deferred set-derivation-cached-data-is-deferred!)
|
||||
(serialized derivation-cached-data-serialized set-derivation-cached-data-serialized!))
|
||||
(path derivation-metadata-path set-derivation-metadata-path!)
|
||||
(modulo-hash derivation-metadata-modulo-hash set-derivation-metadata-modulo-hash!)
|
||||
(is-deferred derivation-metadata-is-deferred set-derivation-metadata-is-deferred!)
|
||||
(serialized derivation-metadata-serialized set-derivation-metadata-serialized!)
|
||||
(meta derivation-metadata-meta set-derivation-metadata-meta!))
|
||||
|
||||
(define-record-printer (<derivation-cached-data> drv out)
|
||||
(fprintf out "#<derivation-cached-data path: ~S, hash: ~S, deferred: ~S (has serialized? ~S)>"
|
||||
(derivation-cached-data-path drv)
|
||||
(derivation-cached-data-modulo-hash drv)
|
||||
(derivation-cached-data-is-deferred drv)
|
||||
(not (not (derivation-cached-data-serialized drv)))))
|
||||
|
||||
(define (derivation-meta drv)
|
||||
(derivation-metadata-meta (derivation-metadata drv)))
|
||||
(define (set-derivation-meta! drv meta)
|
||||
(set-derivation-metadata-meta! (derivation-metadata drv) meta))
|
||||
|
||||
(define-record-printer (<derivation-metadata> drv out)
|
||||
(fprintf out "#<derivation-metadata path: ~S, hash: ~S, deferred: ~S (has serialized? ~S)>"
|
||||
(derivation-metadata-path drv)
|
||||
(derivation-metadata-modulo-hash drv)
|
||||
(derivation-metadata-is-deferred drv)
|
||||
(not (not (derivation-metadata-serialized drv)))))
|
||||
|
||||
;; An entire derivation.
|
||||
;; `outputs` is stored as an alist of output name to `<derivation-output>` object.
|
||||
;; `input-drvs` is stored as an alist of `<derivation>` to a (sorted) list of its outputs that are used.
|
||||
;; The `outputs`, `input-drvs`, `input-src`, and `env` are expected to be sorted.
|
||||
(define-record-type <derivation>
|
||||
(make-derivation name outputs input-drvs input-src system builder args env cached-data)
|
||||
(make-derivation name outputs input-drvs input-src system builder args env metadata)
|
||||
derivation?
|
||||
(name derivation-name)
|
||||
|
||||
|
|
@ -99,13 +108,13 @@
|
|||
(args derivation-args)
|
||||
(env derivation-env)
|
||||
|
||||
(cached-data derivation-cached-data))
|
||||
(metadata derivation-metadata))
|
||||
|
||||
(define is-printing-drv (make-parameter #f))
|
||||
(define-record-printer (<derivation> drv out)
|
||||
(define was-printing-drv (is-printing-drv))
|
||||
(parameterize ((is-printing-drv #t))
|
||||
(fprintf out "#<derivation ~s ~s inputs: ~s ~s, ~s ~s ~s ~s, cached data ~S>"
|
||||
(fprintf out "#<derivation ~s ~s inputs: ~s ~s, ~s ~s ~s ~s, metadata ~S>"
|
||||
(derivation-name drv)
|
||||
(derivation-outputs drv)
|
||||
(if was-printing-drv (map derivation-name (derivation-input-drvs drv)) (derivation-input-drvs drv))
|
||||
|
|
@ -114,7 +123,7 @@
|
|||
(derivation-builder drv)
|
||||
(derivation-args drv)
|
||||
(derivation-env drv)
|
||||
(derivation-cached-data drv))))
|
||||
(derivation-metadata drv))))
|
||||
|
||||
(define (write-delim-list start end fn val port)
|
||||
(write-char start port)
|
||||
|
|
@ -159,7 +168,7 @@
|
|||
(derivation-builder drv)
|
||||
(derivation-args drv)
|
||||
(mask-env (derivation-env drv) (derivation-outputs drv))
|
||||
(make-derivation-cached-data #f #f #f #f)))
|
||||
(make-derivation-metadata #f #f #f #f #f)))
|
||||
|
||||
;; Returns whether this `<derivation>` is considered fixed-output by Nix or not.
|
||||
(define (drv-is-fod drv)
|
||||
|
|
@ -190,7 +199,7 @@
|
|||
; TODO: this needs to merge output names too (depending on two distinct drvs with the same output hash requires merging their output names.)
|
||||
(for-each (lambda (l)
|
||||
(let* ((new-hash (hex (modulo-hash-drv (car l)))))
|
||||
(set! is-deferred (or is-deferred (derivation-cached-data-is-deferred (derivation-cached-data (car l))) (drv-is-impure (car l))))
|
||||
(set! is-deferred (or is-deferred (derivation-metadata-is-deferred (derivation-metadata (car l))) (drv-is-impure (car l))))
|
||||
(unless (assoc new-hash remapped-input-drvs) (set! remapped-input-drvs (cons (cons new-hash (cdr l)) remapped-input-drvs)))))
|
||||
(derivation-input-drvs drv))
|
||||
(set! remapped-input-drvs (list-sort env-pair< remapped-input-drvs))
|
||||
|
|
@ -201,11 +210,11 @@
|
|||
;; changes made (transitively) are which variant of a fixed-output derivation is used. This is
|
||||
;; what is used in the calculation of the output path of an input-addressed derivation.
|
||||
(define (modulo-hash-drv drv)
|
||||
(if (eq? (derivation-cached-data-modulo-hash (derivation-cached-data drv)) #f)
|
||||
(if (eq? (derivation-metadata-modulo-hash (derivation-metadata drv)) #f)
|
||||
(let ((hash (sha256 (modulo-hash-drv-contents drv))))
|
||||
(set-derivation-cached-data-modulo-hash! (derivation-cached-data drv) hash)
|
||||
(set-derivation-metadata-modulo-hash! (derivation-metadata drv) hash)
|
||||
hash)
|
||||
(derivation-cached-data-modulo-hash (derivation-cached-data drv))))
|
||||
(derivation-metadata-modulo-hash (derivation-metadata drv))))
|
||||
|
||||
;; Creates a fixed-output derivation with specified parameters.
|
||||
(define (make-fixed-output-derivation name platform input-drvs input-srcs builder env hash-algo hash-value recursive)
|
||||
|
|
@ -221,7 +230,7 @@
|
|||
("builder" . ,(car builder))
|
||||
("system" . ,platform)
|
||||
. ,new-items)))
|
||||
(make-derivation name (list (cons "out" output)) input-drvs input-srcs platform (car builder) (cdr builder) (list-sort env-pair< (append new-items env)) (make-derivation-cached-data #f #f #f #f)))
|
||||
(make-derivation name (list (cons "out" output)) input-drvs input-srcs platform (car builder) (cdr builder) (list-sort env-pair< (append new-items env)) (make-derivation-metadata #f #f #f #f #f)))
|
||||
|
||||
(define (sanity-check-drv orig-drv)
|
||||
(define tmp-drv (mask-derivation orig-drv))
|
||||
|
|
@ -245,15 +254,15 @@
|
|||
(define tmp-outputs (list-sort env-pair< (map (lambda (l) (cons l (make-derivation-output #f #f #f #f))) outputs)))
|
||||
(define tmp-env (list-sort env-pair< (filter-environment env (append compat-env (map (lambda (l) (cons l "")) outputs)))))
|
||||
|
||||
(define tmp-drv (make-derivation name tmp-outputs input-drvs input-srcs platform (car builder) (cdr builder) tmp-env (make-derivation-cached-data #f #f #f #f)))
|
||||
(define tmp-drv (make-derivation name tmp-outputs input-drvs input-srcs platform (car builder) (cdr builder) tmp-env (make-derivation-metadata #f #f #f #f #f)))
|
||||
(define modulo-hash (modulo-hash-drv tmp-drv))
|
||||
(define is-deferred (derivation-cached-data-is-deferred (derivation-cached-data tmp-drv)))
|
||||
(define is-deferred (derivation-metadata-is-deferred (derivation-metadata tmp-drv)))
|
||||
|
||||
(define new-outputs (list-sort env-pair< (map (lambda (l) (cons l (make-derivation-output
|
||||
(if is-deferred #f (make-output-path "sha256" modulo-hash l name)) #f #f #f))) outputs)))
|
||||
(define new-env (list-sort env-pair< (filter-environment env (append compat-env (map (lambda (l) (cons l (make-output-path "sha256" modulo-hash l name))) outputs)))))
|
||||
|
||||
(define drv (make-derivation name new-outputs input-drvs input-srcs platform (car builder) (cdr builder) new-env (make-derivation-cached-data #f #f (derivation-cached-data-is-deferred (derivation-cached-data tmp-drv)) #f)))
|
||||
(define drv (make-derivation name new-outputs input-drvs input-srcs platform (car builder) (cdr builder) new-env (make-derivation-metadata #f #f (derivation-metadata-is-deferred (derivation-metadata tmp-drv)) #f #f)))
|
||||
(sanity-check-drv drv)
|
||||
drv)
|
||||
|
||||
|
|
@ -265,7 +274,7 @@
|
|||
#f 'impure "sha256" #t))) noutputs)))
|
||||
(define env (list-sort env-pair< (filter-environment env (append compat-env (map (lambda (l) (cons (car l) (make-placeholder (car l)))) outputs)))))
|
||||
|
||||
(define drv (make-derivation name outputs input-drvs input-srcs platform (car builder) (cdr builder) env (make-derivation-cached-data #f #f #t #f)))
|
||||
(define drv (make-derivation name outputs input-drvs input-srcs platform (car builder) (cdr builder) env (make-derivation-metadata #f #f #t #f #f)))
|
||||
(define pathhash (string-copy (derivation-path drv) (+ 1 (string-length (%store-dir))) (+ 33 (string-length (%store-dir)))))
|
||||
(for-each (lambda (pair) (set-derivation-output-path! (cdr pair) (make-upstream-output-placeholder pathhash name (car pair)))) (derivation-outputs drv))
|
||||
drv)
|
||||
|
|
@ -278,7 +287,7 @@
|
|||
#f 'floating "sha256" #t))) noutputs)))
|
||||
(define env (list-sort env-pair< (filter-environment nenv (append compat-env (map (lambda (l) (cons (car l) (make-placeholder (car l)))) outputs)))))
|
||||
|
||||
(define drv (make-derivation name outputs input-drvs input-srcs platform (car builder) (cdr builder) env (make-derivation-cached-data #f #f #t #f)))
|
||||
(define drv (make-derivation name outputs input-drvs input-srcs platform (car builder) (cdr builder) env (make-derivation-metadata #f #f #t #f #f)))
|
||||
(define pathhash (string-copy (derivation-path drv) (+ 1 (string-length (%store-dir))) (+ 33 (string-length (%store-dir)))))
|
||||
(for-each (lambda (pair) (set-derivation-output-path! (cdr pair) (make-upstream-output-placeholder pathhash name (car pair)))) (derivation-outputs drv))
|
||||
drv)
|
||||
|
|
@ -304,19 +313,19 @@
|
|||
|
||||
;; Returns the store path belonging to this derivation's `.drv` file.
|
||||
(define (derivation-path drv)
|
||||
(if (eq? (derivation-cached-data-path (derivation-cached-data drv)) #f)
|
||||
(if (eq? (derivation-metadata-path (derivation-metadata drv)) #f)
|
||||
(let ((drv-output-port (open-output-bytevector)))
|
||||
(derivation-serialize drv drv-output-port)
|
||||
(define path (make-text-path "sha256" (sha256 (get-output-bytevector drv-output-port)) (string-append (derivation-name drv) ".drv") (derivation-path-references drv)))
|
||||
(set-derivation-cached-data-path! (derivation-cached-data drv) path)
|
||||
(set-derivation-metadata-path! (derivation-metadata drv) path)
|
||||
path)
|
||||
(derivation-cached-data-path (derivation-cached-data drv))))
|
||||
(derivation-metadata-path (derivation-metadata drv))))
|
||||
|
||||
(define (derivation-equal? left right)
|
||||
(define left-cached-path (derivation-cached-data-path (derivation-cached-data left)))
|
||||
(define right-cached-path (derivation-cached-data-path (derivation-cached-data right)))
|
||||
(define left-serialized (derivation-cached-data-serialized (derivation-cached-data left)))
|
||||
(define right-serialized (derivation-cached-data-serialized (derivation-cached-data right)))
|
||||
(define left-cached-path (derivation-metadata-path (derivation-metadata left)))
|
||||
(define right-cached-path (derivation-metadata-path (derivation-metadata right)))
|
||||
(define left-serialized (derivation-metadata-serialized (derivation-metadata left)))
|
||||
(define right-serialized (derivation-metadata-serialized (derivation-metadata right)))
|
||||
|
||||
(or (eqv? left right)
|
||||
(and left-cached-path right-cached-path (string=? left-cached-path right-cached-path))
|
||||
|
|
@ -470,7 +479,7 @@
|
|||
(read-static-string "," port)
|
||||
(define environ (read-bracket-list (lambda () (define data (read-paren-list (lambda () (read-quoted-string port)) port)) (cons (car data) (cadr data))) port))
|
||||
(read-static-string ")" port)
|
||||
(make-derivation name drv-outputs input-drvs input-srcs system builder-argv0 builder-args environ (make-derivation-cached-data #f #f #f #f)))))
|
||||
(make-derivation name drv-outputs input-drvs input-srcs system builder-argv0 builder-args environ (make-derivation-metadata #f #f #f #f #f)))))
|
||||
|
||||
(define (derivation-serialize-internal drv port masked)
|
||||
(parameterize ((current-output-port port))
|
||||
|
|
@ -502,12 +511,12 @@
|
|||
(case-lambda
|
||||
((drv) (derivation-serialize drv (current-output-port)))
|
||||
((drv port)
|
||||
(if (derivation-cached-data-serialized (derivation-cached-data drv))
|
||||
(write-bytevector (derivation-cached-data-serialized (derivation-cached-data drv)) port)
|
||||
(if (derivation-metadata-serialized (derivation-metadata drv))
|
||||
(write-bytevector (derivation-metadata-serialized (derivation-metadata drv)) port)
|
||||
(call-with-port (open-output-bytevector)
|
||||
(lambda (nport)
|
||||
(derivation-serialize-internal drv nport (derivation-input-drvs drv))
|
||||
(set-derivation-cached-data-serialized! (derivation-cached-data drv) (get-output-bytevector nport))
|
||||
(set-derivation-metadata-serialized! (derivation-metadata drv) (get-output-bytevector nport))
|
||||
(write-bytevector (get-output-bytevector nport) port)))))
|
||||
((drv port masked)
|
||||
(derivation-serialize-internal drv port masked))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue