cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make sure to keep roots for channel instance derivations

Browse source
This commit is contained in:
Christopher Baines 2024-01-28 08:18:44 +00:00
parent 39f626aa45
commit 0f7b31c605
1 changed files with 24 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

26
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1132,6 +1132,7 @@
(list channel) (list channel)
#:authenticate? #:authenticate?
fetch-with-authentication?))))))) fetch-with-authentication?)))))))
(pool-store-connections '())
(inferior-and-store-pool (inferior-and-store-pool
(make-resource-pool (make-resource-pool
(lambda () (lambda ()
@ -1139,14 +1140,20 @@
(inferior (start-inferior inferior-store))) (inferior (start-inferior inferior-store)))
(ensure-non-blocking-store-connection inferior-store) (ensure-non-blocking-store-connection inferior-store)
(make-inferior-non-blocking! inferior) (make-inferior-non-blocking! inferior)
(call-with-blocked-asyncs
(lambda ()
(set! pool-store-connections
(cons inferior-store pool-store-connections))))
(cons inferior inferior-store))) (cons inferior inferior-store)))
parallelism parallelism
#:min-size 0 #:min-size 0
#:idle-seconds 10 #:idle-seconds 10
#:destructor (match-lambda #:destructor (match-lambda
((inferior . store) ((inferior . store)
(close-inferior inferior) ;; Just close the inferior here, close the store
(close-connection store))))) ;; connection later to keep the temporary roots
;; alive
(close-inferior inferior)))))
(systems (systems
(with-resource-from-pool inferior-and-store-pool res (with-resource-from-pool inferior-and-store-pool res
(match res (match res
@ -1173,6 +1180,21 @@
system))))))) system)))))))
systems))) 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 (cons
(channel-instance-checkout channel-instance) (channel-instance-checkout channel-instance)
result))) result)))