(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:
puck 2025-06-10 14:44:51 +00:00
parent 895fb39c76
commit a2ec3ded0f

View file

@ -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))))))