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

(zilch magic): handle FODs with CA dependencies properly

Browse source 
Whilst not CA themselves, they can safely depend on CA inputs. Thus,
they need rewrites.
This commit is contained in:
puck 2025-06-23 12:22:20 +00:00
parent c192be2cf8
commit 78b41236ab
1 changed files with 32 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

26
core/src/magic.sld
View file

@ -265,6 +265,12 @@
(define (drv-is-ca drv) (define (drv-is-ca drv)
(define is-ca #f) (define is-ca #f)
(for-each (lambda (out) (when (eq? (derivation-output-hash (cdr out)) 'floating) (set! is-ca #t))) (derivation-outputs drv)) (for-each (lambda (out) (when (eq? (derivation-output-hash (cdr out)) 'floating) (set! is-ca #t))) (derivation-outputs drv))
(when (drv-is-fod drv)
(let loop ((drvs (derivation-input-drvs drv)))
(cond
((null? drvs) #f)
((drv-is-ca (caar drvs)) (set! is-ca #t))
(else (loop (cdr drvs))))))
is-ca) is-ca)
(define (rewrite-string str with-rewrites) (define (rewrite-string str with-rewrites)
@ -414,6 +420,20 @@
(define new-args (map (lambda (v) (rewrite-string-or-bytevector v rewrites)) (derivation-args ca-drv))) (define new-args (map (lambda (v) (rewrite-string-or-bytevector v rewrites)) (derivation-args ca-drv)))
(define new-env (map (lambda (kv) (cons (car kv) (rewrite-string-or-bytevector (cdr kv) rewrites))) (derivation-env ca-drv))) (define new-env (map (lambda (kv) (cons (car kv) (rewrite-string-or-bytevector (cdr kv) rewrites))) (derivation-env ca-drv)))
(define ia-drv (define ia-drv
(if (drv-is-fod ca-drv)
(let ((output (cdar (derivation-outputs ca-drv))))
(make-fixed-output-derivation
(derivation-name ca-drv)
(derivation-system ca-drv)
(list-sort
(lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r))))
new-drvs)
(list-sort string<? new-srcs)
(cons new-builder new-args)
new-env
(derivation-output-algo output)
(derivation-output-hash output)
(derivation-output-recursive output)))
(make-input-addressed-derivation (make-input-addressed-derivation
(derivation-name ca-drv) (derivation-name ca-drv)
(derivation-system ca-drv) (derivation-system ca-drv)
@ -421,7 +441,7 @@
(lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r)))) (lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r))))
new-drvs) new-drvs)
(list-sort string<? new-srcs) (list-sort string<? new-srcs)
(cons new-builder new-args) new-env (map car (derivation-outputs ca-drv)))) (cons new-builder new-args) new-env (map car (derivation-outputs ca-drv)))))
(set-pending-item-ia-drv! item ia-drv) (set-pending-item-ia-drv! item ia-drv)
; Build all the paths. ; Build all the paths.
@ -443,12 +463,14 @@
(lambda () (lambda ()
(daemon-wop-build-paths conn (list->vector (map (lambda (v) (string-append (derivation-path ia-drv) "!" v)) outputs))))) (daemon-wop-build-paths conn (list->vector (map (lambda (v) (string-append (derivation-path ia-drv) "!" v)) outputs)))))
(daemon-wop-build-paths conn (list->vector (map (lambda (v) (string-append (derivation-path ia-drv) "!" v)) outputs)))) (daemon-wop-build-paths conn (list->vector (map (lambda (v) (string-append (derivation-path ia-drv) "!" v)) outputs))))
(if (drv-is-fod ia-drv)
(set-pending-item-resolved-paths! item (list (cons "out" (derivation-output-path (cdar (derivation-outputs ia-drv))))))
(set-pending-item-resolved-paths! item (set-pending-item-resolved-paths! item
(map (lambda (o) (map (lambda (o)
(define-values (name hash nar-size ca-store-path) (define-values (name hash nar-size ca-store-path)
(store-path-to-fod conn (derivation-output-path (cdr (assoc o (derivation-outputs ia-drv) string=?))))) (store-path-to-fod conn (derivation-output-path (cdr (assoc o (derivation-outputs ia-drv) string=?)))))
(cons o ca-store-path)) (cons o ca-store-path))
outputs)) outputs)))
; Notify our dependencies that we're done. ; Notify our dependencies that we're done.
(mutex-lock! pending-count-mutex) (mutex-lock! pending-count-mutex)