Make sure to keep roots for channel instance derivations

This commit is contained in:
Christopher Baines 2024-01-28 08:18:44 +00:00
parent 39f626aa45
commit 0f7b31c605

View file

@ -1132,6 +1132,7 @@
(list channel)
#:authenticate?
fetch-with-authentication?)))))))
(pool-store-connections '())
(inferior-and-store-pool
(make-resource-pool
(lambda ()
@ -1139,14 +1140,20 @@
(inferior (start-inferior inferior-store)))
(ensure-non-blocking-store-connection inferior-store)
(make-inferior-non-blocking! inferior)
(call-with-blocked-asyncs
(lambda ()
(set! pool-store-connections
(cons inferior-store pool-store-connections))))
(cons inferior inferior-store)))
parallelism
#:min-size 0
#:idle-seconds 10
#:destructor (match-lambda
((inferior . store)
(close-inferior inferior)
(close-connection store)))))
;; Just close the inferior here, close the store
;; connection later to keep the temporary roots
;; alive
(close-inferior inferior)))))
(systems
(with-resource-from-pool inferior-and-store-pool res
(match res
@ -1173,6 +1180,21 @@
system)))))))
systems)))
(for-each
(match-lambda
((_ . manifest-and-profile)
(and=> (assq-ref manifest-and-profile 'manifest-entry-item)
(lambda (drv)
(add-temp-root store drv)))
(and=> (assq-ref manifest-and-profile 'profile)
(lambda (drv)
(add-temp-root store drv)))))
result)
;; Now the roots have been added to the main store connection, close the
;; pool ones
(for-each close-connection pool-store-connections)
(cons
(channel-instance-checkout channel-instance)
result)))