From c335775ed41c07c6fc1e3d7d939c90bec7b8c9cd Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 16 Aug 2024 11:18:40 +0100
Subject: Check the WAL size before computing lint warnings

As even though this might not use the store, the inferior still holds a store
connection open.
---
 guix-data-service/jobs/load-new-guix-revision.scm | 46 ++++++++++++-----------
 1 file changed, 24 insertions(+), 22 deletions(-)

(limited to 'guix-data-service')

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 189b121..a7da8a8 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1824,6 +1824,22 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
          (with-resource-from-pool postgresql-connection-pool conn
            (insert-packages conn packages-data))))))
 
+  (define (check-wal-size)
+    (let loop ((wal-bytes
+                (catch #t
+                  (lambda ()
+                    (stat:size (stat "/var/guix/db/db.sqlite-wal")))
+                  (lambda _ 0))))
+      (when (> wal-bytes (* 512 (expt 2 20)))
+        (simple-format #t "debug: guix-daemon WAL is large (~A), waiting\n"
+                       wal-bytes)
+
+        (sleep 30)
+        (loop (catch #t
+                (lambda ()
+                  (stat:size (stat "/var/guix/db/db.sqlite-wal")))
+                (lambda _ 0))))))
+
   (define (extract-and-store-lint-checkers-and-warnings)
     (define inferior-lint-checkers-data
       (with-resource-from-pool inf-and-store-pool res
@@ -1852,12 +1868,14 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                                ;; Running the derivation linter is
                                ;; currently infeasible
                                (not (eq? checker-name 'derivation)))
-                          (with-resource-from-pool inf-and-store-pool res
-                            (match res
-                              ((inferior . inferior-store)
-                               (inferior-lint-warnings inferior
-                                                       inferior-store
-                                                       checker-name)))))))
+                          (begin
+                            (check-wal-size)
+                            (with-resource-from-pool inf-and-store-pool res
+                              (match res
+                                ((inferior . inferior-store)
+                                 (inferior-lint-warnings inferior
+                                                         inferior-store
+                                                         checker-name))))))))
                   inferior-lint-checkers-data)))
 
         (let ((package-ids (fibers-force package-ids-promise)))
@@ -1891,22 +1909,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
 
     (define chunk-size 3000)
 
-    (define (check-wal-size)
-      (let loop ((wal-bytes
-                  (catch #t
-                    (lambda ()
-                      (stat:size (stat "/var/guix/db/db.sqlite-wal")))
-                    (lambda _ 0))))
-        (when (> wal-bytes (* 512 (expt 2 20)))
-          (simple-format #t "debug: guix-daemon WAL is large (~A), waiting\n"
-                         wal-bytes)
-
-          (sleep 30)
-          (loop (catch #t
-                  (lambda ()
-                    (stat:size (stat "/var/guix/db/db.sqlite-wal")))
-                  (lambda _ 0))))))
-
     (define (process-system-and-target system target)
       (with-time-logging
           (simple-format #f "processing derivations for ~A" (cons system target))
-- 
cgit v1.2.3