02/03: Don't start new jobs when there's low disk space

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit a667db2f5deed680a1703cfb4942827a38517586
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Mon Mar 11 19:34:20 2024 +0000

    Don't start new jobs when there's low disk space
---
 guix-data-service/jobs.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/guix-data-service/jobs.scm b/guix-data-service/jobs.scm
index 8217d52..7d62be3 100644
--- a/guix-data-service/jobs.scm
+++ b/guix-data-service/jobs.scm
@@ -22,6 +22,7 @@
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 textual-ports)
   #:use-module (squee)
+  #:use-module (guix build syscalls)
   #:use-module (guix-data-service utils)
   #:use-module (guix-data-service database)
   #:use-module (guix-data-service jobs load-new-guix-revision)
@@ -128,7 +129,15 @@ guix-data-service: error: missing log line: ~A
                        skip-system-tests?
                        per-job-parallelism)
   (define (fetch-new-jobs)
-    (fetch-unlocked-jobs conn))
+    (let ((free-space (free-disk-space "/gnu/store")))
+      (if (< free-space (* 2 (expt 2 30))) ; 2G
+          (begin
+            (simple-format
+             (current-error-port)
+             "not starting new jobs, low free disk space on /gnu/store (~A)\n"
+             free-space)
+            '())
+          (fetch-unlocked-jobs conn))))
 
   (define (process-job job-id)
     (let ((log-port (start-thread-for-process-output job-id)))