Attempt to avoid the WAL growing excessively

1 files changed, 20 insertions, 5 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index e2fb379..5c2744c 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1427,14 +1427,21 @@
                                                            guix-locpath)))
          (ensure-non-blocking-store-connection inferior-store)
          (make-inferior-non-blocking! inferior)
+
+         (simple-format #t "debug: started new inferior and store connection\n")
+
          (cons inferior inferior-store)))
      parallelism
      #:min-size 0
-     #:idle-seconds 10
-     #:destructor (match-lambda
-                    ((inferior . store)
-                     (close-connection store)
-                     (close-inferior inferior)))))
+     #:idle-seconds 2
+     #:destructor
+     (match-lambda
+       ((inferior . store)
+        (simple-format
+         #t "debug: closing inferior and associated store connection\n")
+
+        (close-connection store)
+        (close-inferior inferior)))))
 
   (define add-temp-root/long-running-store
     (let ((channel (make-channel)))
@@ -1477,6 +1484,14 @@
              (par-map&
               (match-lambda
                 ((system . target)
+                 (let loop ((wal-bytes (stat:size (stat "/var/guix/db/db.sqlite-wal"))))
+                   (when (> wal-bytes 200000000)
+                     (simple-format #t "debug: guix-daemon WAL is large (~A), waiting\n"
+                                    wal-bytes)
+
+                     (sleep 30)
+                     (loop (stat:size (stat "/var/guix/db/db.sqlite-wal")))))
+
                  (with-resource-from-pool inf-and-store-pool res
                    (with-time-logging
                        (simple-format #f "getting derivations for ~A" (cons system target))