puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch nix drv): add derivation metadata slot

Browse source 
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
1 changed files with 57 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

105
core/src/nix/drv.sld
View file

@ -19,7 +19,9 @@
derivation-name derivation-outputs derivation-input-drvs derivation-name derivation-outputs derivation-input-drvs
derivation-input-src derivation-system derivation-builder derivation-input-src derivation-system derivation-builder
derivation-args derivation-env derivation-equal? derivation-args derivation-env derivation-equal?
derivation-meta set-derivation-meta!
derivation-serialize derivation-path-references derivation-path derivation-read read-drv-path 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 make-fixed-output-derivation make-input-addressed-derivation make-impure-derivation make-ca-derivation
modulo-hash-drv-contents) modulo-hash-drv-contents)
@ -46,43 +48,50 @@
(hash derivation-output-hash) (hash derivation-output-hash)
(algo derivation-output-algo) (algo derivation-output-algo)
(recursive derivation-output-recursive)) (recursive derivation-output-recursive))
(define-record-printer (<derivation-output> drvout out) (define-record-printer (<derivation-output> drvout out)
(fprintf out "#<derivation-output ~s hash: ~s algo: ~s recursive: ~s>" (fprintf out "#<derivation-output ~s hash: ~s algo: ~s recursive: ~s>"
(derivation-output-path drvout) (derivation-output-path drvout)
(derivation-output-hash drvout) (derivation-output-hash drvout)
(derivation-output-algo drvout) (derivation-output-algo drvout)
(derivation-output-recursive drvout))) (derivation-output-recursive drvout)))
(define (derivation-output-placeholder? drvout) (define (derivation-output-placeholder? drvout)
(member (derivation-output-hash drvout) '(floating impure))) (member (derivation-output-hash drvout) '(floating impure)))
(define (derivation-output-path-length drv output-name) (define (derivation-output-path-length drv output-name)
; /nix/store/a0a3n97c93ckfg3a920aqnycxdznbbmi-module-output ; /nix/store/a0a3n97c93ckfg3a920aqnycxdznbbmi-module-output
(+ (string-length (%store-dir)) 34 (string-length (derivation-name drv)) (if (string=? output-name "out") 0 (+ 1 (string-length output-name))))) (+ (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. ;; Internal use; stores the precalculated .drv path and modulo hash.
(define-record-type <derivation-cached-data> (define-record-type <derivation-metadata>
(make-derivation-cached-data path modulo-hash is-deferred serialized) (make-derivation-metadata path modulo-hash is-deferred serialized meta)
derivation-cached-data? derivation-cached-data?
(path derivation-cached-data-path set-derivation-cached-data-path!) (path derivation-metadata-path set-derivation-metadata-path!)
(modulo-hash derivation-cached-data-modulo-hash set-derivation-cached-data-modulo-hash!) (modulo-hash derivation-metadata-modulo-hash set-derivation-metadata-modulo-hash!)
(is-deferred derivation-cached-data-is-deferred set-derivation-cached-data-is-deferred!) (is-deferred derivation-metadata-is-deferred set-derivation-metadata-is-deferred!)
(serialized derivation-cached-data-serialized set-derivation-cached-data-serialized!)) (serialized derivation-metadata-serialized set-derivation-metadata-serialized!)
(meta derivation-metadata-meta set-derivation-metadata-meta!))
(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)))))
(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)))))
;; An entire derivation. ;; An entire derivation.
;; `outputs` is stored as an alist of output name to `<derivation-output>` object. ;; `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. ;; `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. ;; The `outputs`, `input-drvs`, `input-src`, and `env` are expected to be sorted.
(define-record-type <derivation> (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? derivation?
(name derivation-name) (name derivation-name)
@ -99,13 +108,13 @@
(args derivation-args) (args derivation-args)
(env derivation-env) (env derivation-env)
(cached-data derivation-cached-data)) (metadata derivation-metadata))
(define is-printing-drv (make-parameter #f)) (define is-printing-drv (make-parameter #f))
(define-record-printer (<derivation> drv out) (define-record-printer (<derivation> drv out)
(define was-printing-drv (is-printing-drv)) (define was-printing-drv (is-printing-drv))
(parameterize ((is-printing-drv #t)) (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-name drv)
(derivation-outputs drv) (derivation-outputs drv)
(if was-printing-drv (map derivation-name (derivation-input-drvs drv)) (derivation-input-drvs drv)) (if was-printing-drv (map derivation-name (derivation-input-drvs drv)) (derivation-input-drvs drv))
@ -114,7 +123,7 @@
(derivation-builder drv) (derivation-builder drv)
(derivation-args drv) (derivation-args drv)
(derivation-env drv) (derivation-env drv)
(derivation-cached-data drv)))) (derivation-metadata drv))))
(define (write-delim-list start end fn val port) (define (write-delim-list start end fn val port)
(write-char start port) (write-char start port)
@ -147,7 +156,7 @@
(cons (car l) "") (cons (car l) "")
l)) l))
env)) env))
;; Return a copy of the received `<derivation>`, but with the outputs masked out. ;; Return a copy of the received `<derivation>`, but with the outputs masked out.
(define (mask-derivation drv) (define (mask-derivation drv)
(make-derivation (make-derivation
@ -159,7 +168,7 @@
(derivation-builder drv) (derivation-builder drv)
(derivation-args drv) (derivation-args drv)
(mask-env (derivation-env drv) (derivation-outputs 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. ;; Returns whether this `<derivation>` is considered fixed-output by Nix or not.
(define (drv-is-fod drv) (define (drv-is-fod drv)
@ -174,7 +183,7 @@
(define (env-pair< left right) (define (env-pair< left right)
(string<? (car left) (car right))) (string<? (car left) (car right)))
;; Calculate the "modulo" contents (that will have to be hashed) of a derivation. ;; Calculate the "modulo" contents (that will have to be hashed) of a derivation.
(define (modulo-hash-drv-contents drv) (define (modulo-hash-drv-contents drv)
(cond (cond
@ -190,23 +199,23 @@
; TODO: this needs to merge output names too (depending on two distinct drvs with the same output hash requires merging their output names.) ; 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) (for-each (lambda (l)
(let* ((new-hash (hex (modulo-hash-drv (car 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))))) (unless (assoc new-hash remapped-input-drvs) (set! remapped-input-drvs (cons (cons new-hash (cdr l)) remapped-input-drvs)))))
(derivation-input-drvs drv)) (derivation-input-drvs drv))
(set! remapped-input-drvs (list-sort env-pair< remapped-input-drvs)) (set! remapped-input-drvs (list-sort env-pair< remapped-input-drvs))
(derivation-serialize drv output-port remapped-input-drvs) (derivation-serialize drv output-port remapped-input-drvs)
(get-output-bytevector output-port))))) (get-output-bytevector output-port)))))
;; Modulo-hash a derivation. This returns a hash that will stay the same, as long as the only ;; Modulo-hash a derivation. This returns a hash that will stay the same, as long as the only
;; changes made (transitively) are which variant of a fixed-output derivation is used. This is ;; 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. ;; what is used in the calculation of the output path of an input-addressed derivation.
(define (modulo-hash-drv drv) (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)))) (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) 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. ;; 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) (define (make-fixed-output-derivation name platform input-drvs input-srcs builder env hash-algo hash-value recursive)
(define output-path (make-fixed-output-path recursive hash-algo hash-value name)) (define output-path (make-fixed-output-path recursive hash-algo hash-value name))
@ -221,7 +230,7 @@
("builder" . ,(car builder)) ("builder" . ,(car builder))
("system" . ,platform) ("system" . ,platform)
. ,new-items))) . ,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 (sanity-check-drv orig-drv)
(define tmp-drv (mask-derivation 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-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-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 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 (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))) (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 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) (sanity-check-drv drv)
drv) drv)
@ -265,7 +274,7 @@
#f 'impure "sha256" #t))) noutputs))) #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 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))))) (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)) (for-each (lambda (pair) (set-derivation-output-path! (cdr pair) (make-upstream-output-placeholder pathhash name (car pair)))) (derivation-outputs drv))
drv) drv)
@ -278,7 +287,7 @@
#f 'floating "sha256" #t))) noutputs))) #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 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))))) (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)) (for-each (lambda (pair) (set-derivation-output-path! (cdr pair) (make-upstream-output-placeholder pathhash name (car pair)))) (derivation-outputs drv))
drv) drv)
@ -296,7 +305,7 @@
((eq? (derivation-output-hash output) 'floating) "") ((eq? (derivation-output-hash output) 'floating) "")
((not (derivation-output-hash output)) "") ((not (derivation-output-hash output)) "")
(else (error "unknown derivation output hash type")))))) (else (error "unknown derivation output hash type"))))))
;; Returns a sorted list of store paths that the `.drv` file of this derivation depends on. ;; Returns a sorted list of store paths that the `.drv` file of this derivation depends on.
(define (derivation-path-references drv) (define (derivation-path-references drv)
(define input-drv-paths (map (lambda (l) (if (string? (car l)) (car l) (derivation-path (car l)))) (derivation-input-drvs drv))) (define input-drv-paths (map (lambda (l) (if (string? (car l)) (car l) (derivation-path (car l)))) (derivation-input-drvs drv)))
@ -304,19 +313,19 @@
;; Returns the store path belonging to this derivation's `.drv` file. ;; Returns the store path belonging to this derivation's `.drv` file.
(define (derivation-path drv) (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))) (let ((drv-output-port (open-output-bytevector)))
(derivation-serialize drv drv-output-port) (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))) (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) path)
(derivation-cached-data-path (derivation-cached-data drv)))) (derivation-metadata-path (derivation-metadata drv))))
(define (derivation-equal? left right) (define (derivation-equal? left right)
(define left-cached-path (derivation-cached-data-path (derivation-cached-data left))) (define left-cached-path (derivation-metadata-path (derivation-metadata left)))
(define right-cached-path (derivation-cached-data-path (derivation-cached-data right))) (define right-cached-path (derivation-metadata-path (derivation-metadata right)))
(define left-serialized (derivation-cached-data-serialized (derivation-cached-data left))) (define left-serialized (derivation-metadata-serialized (derivation-metadata left)))
(define right-serialized (derivation-cached-data-serialized (derivation-cached-data right))) (define right-serialized (derivation-metadata-serialized (derivation-metadata right)))
(or (eqv? left right) (or (eqv? left right)
(and left-cached-path right-cached-path (string=? left-cached-path right-cached-path)) (and left-cached-path right-cached-path (string=? left-cached-path right-cached-path))
@ -470,7 +479,7 @@
(read-static-string "," port) (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)) (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) (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) (define (derivation-serialize-internal drv port masked)
(parameterize ((current-output-port port)) (parameterize ((current-output-port port))
@ -502,12 +511,12 @@
(case-lambda (case-lambda
((drv) (derivation-serialize drv (current-output-port))) ((drv) (derivation-serialize drv (current-output-port)))
((drv port) ((drv port)
(if (derivation-cached-data-serialized (derivation-cached-data drv)) (if (derivation-metadata-serialized (derivation-metadata drv))
(write-bytevector (derivation-cached-data-serialized (derivation-cached-data drv)) port) (write-bytevector (derivation-metadata-serialized (derivation-metadata drv)) port)
(call-with-port (open-output-bytevector) (call-with-port (open-output-bytevector)
(lambda (nport) (lambda (nport)
(derivation-serialize-internal drv nport (derivation-input-drvs drv)) (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))))) (write-bytevector (get-output-bytevector nport) port)))))
((drv port masked) ((drv port masked)
(derivation-serialize-internal drv port masked)))))) (derivation-serialize-internal drv port masked))))))