Don't start new jobs when there's low disk space

1 files changed, 10 insertions, 1 deletions

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)))