hydra: services: Preserve Cuirass .drv GC roots.

By removing .drv GC root behind the back of Cuirass, we were
occasionally causing build failures with “missing .drv” errors.

Partly fixes <https://issues.guix.gnu.org/54447>.

* hydra/modules/sysadmin/services.scm (cleanup-cuirass-roots): Remove
code that would delete referrers of the targeted roots.
(guix-daemon-config)[extra-options]: Remove “--gc-keep-outputs”.
This commit is contained in:
Ludovic Courtès 2023-10-16 19:21:41 +02:00
parent b8fc66c043
commit e40d961b5a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 3 additions and 37 deletions

View File

@ -110,9 +110,7 @@
((guix config) => ,(make-config.scm)))
#~(begin
(use-modules (ice-9 ftw)
(srfi srfi-1)
(guix store)
(guix derivations))
(srfi srfi-1))
(define %roots-directory
"/var/guix/profiles/per-user/cuirass/cuirass")
@ -157,28 +155,6 @@
deleted))
deleted))
(define (root-target root)
;; Return the store item ROOT refers to.
(string-append (%store-prefix) "/" (basename root)))
(define (derivation-referrers store item)
;; Return the referrers of the derivers of ITEM.
(let* ((derivers (valid-derivers store item))
(referrers (append-map (lambda (drv)
(referrers store drv))
derivers)))
(delete-duplicates referrers)))
(define (delete-gc-root-for-derivation drv)
;; Delete the GC root for DRV, if any.
(catch 'system-error
(lambda ()
(let ((item (derivation-path->output-path drv)))
(delete-file
(string-append %roots-directory
"/" (basename drv)))))
(const #f)))
;; Note: 'scandir' would introduce too much overhead due
;; to the large number of entries that it would sort.
(define deleted
@ -197,17 +173,7 @@
(for-each (lambda (file)
(display file port)
(newline port))
deleted)))
;; Since we run 'guix-daemon --gc-keep-outputs
;; --gc-keep-derivations', also remove GC roots for the outputs of
;; derivations that refer to the derivers of DELETED.
(for-each delete-gc-root-for-derivation
(with-store store
(append-map (lambda (root)
(derivation-referrers
store (root-target root)))
deleted))))))))
deleted))))))))
(define (gc-jobs threshold)
"Return the garbage collection mcron jobs. The garbage collection
@ -252,7 +218,7 @@ collection instead."
(build-accounts (* build-accounts-to-max-jobs-ratio max-jobs))
(extra-options (list "--max-jobs" (number->string max-jobs)
"--cores" (number->string cores)
"--gc-keep-outputs" "--gc-keep-derivations"))))
"--gc-keep-derivations"))))
;;;