Retry computing channel instance manifests

On readlink errors.
This commit is contained in:
Christopher Baines 2025-05-24 11:46:27 +01:00
parent 961441cab0
commit d8ae6062b1

View file

@ -1570,24 +1570,34 @@ SELECT store_path FROM derivation_source_files WHERE id = $1"
(commit ,(channel-commit channel))) (commit ,(channel-commit channel)))
,(channel-instance-commit channel-instance) ,(channel-instance-commit channel-instance)
,(channel-instance-checkout channel-instance))))) ,(channel-instance-checkout channel-instance)))))
(simple-format
(current-error-port)
"guix-data-service: computing the derivation-file-name for ~A\n"
system)
(let ((manifest (define (compute)
(catch #t (simple-format
(lambda () (current-error-port)
((channel-instances->manifest instances #:system system) store)) "guix-data-service: computing the derivation-file-name for ~A\n"
(lambda (key . args) system)
(simple-format
(current-error-port) (catch #t
"error: while computing manifest entry derivation for ~A\n" (lambda ()
system) ((channel-instances->manifest instances #:system system) store))
(simple-format (lambda (key . args)
(current-error-port) (simple-format
"error ~A: ~A\n" key args) (current-error-port)
#f)))) "error: while computing manifest entry derivation for ~A\n"
system)
(simple-format
(current-error-port)
"error ~A: ~A\n" key args)
(match (cons key args)
(('system-error "readlink" _ ...)
'retry)
(_ #f)))))
(let loop ((manifest (compute)))
(when (eq? mainfest 'retry)
(loop (compute)))
(define (add-tmp-root-and-return-drv drv) (define (add-tmp-root-and-return-drv drv)
(add-temp-root store drv) (add-temp-root store drv)
drv) drv)