From e40d961b5a6d68a356abd54f252b7e8ed1a5209f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 16 Oct 2023 19:21:41 +0200
Subject: [PATCH] hydra: services: Preserve Cuirass .drv GC roots.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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”.
---
 hydra/modules/sysadmin/services.scm | 40 +++--------------------------
 1 file changed, 3 insertions(+), 37 deletions(-)

diff --git a/hydra/modules/sysadmin/services.scm b/hydra/modules/sysadmin/services.scm
index 260b1ae..1a7c247 100644
--- a/hydra/modules/sysadmin/services.scm
+++ b/hydra/modules/sysadmin/services.scm
@@ -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"))))
 
 
 ;;;