Don't start new jobs when there's low disk space
This commit is contained in:
parent
7d1cc4d325
commit
a667db2f5d
1 changed files with 10 additions and 1 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue