cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make the free space requirement configurable

Browse source
This commit is contained in:
Christopher Baines 2024-08-20 09:49:41 +01:00
parent 6de908d0f4
commit f6eadb0b16
2 changed files with 14 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

6
guix-data-service/jobs.scm
View file

@ -128,10 +128,12 @@ guix-data-service: error: missing log line: ~A
latest-branch-revision-max-processes latest-branch-revision-max-processes
skip-system-tests? skip-system-tests?
extra-inferior-environment-variables extra-inferior-environment-variables
per-job-parallelism) per-job-parallelism
(free-space-requirement
(* 2 (expt 2 30)))) ; 2G
(define (fetch-new-jobs) (define (fetch-new-jobs)
(let ((free-space (free-disk-space "/gnu/store"))) (let ((free-space (free-disk-space "/gnu/store")))
(if (< free-space (* 2 (expt 2 30))) ; 2G (if (< free-space free-space-requirement)
(begin (begin
(simple-format (simple-format
(current-error-port) (current-error-port)

9
scripts/guix-data-service-process-jobs.in
View file

@ -55,6 +55,11 @@
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'inferior-environment-variable (alist-cons 'inferior-environment-variable
(string-split arg #\=) (string-split arg #\=)
result)))
(option '("free-space-requirement") #t #f
(lambda (opt name arg result)
(alist-cons 'free-space-requirement
(string->number arg)
result))))) result)))))
(define %default-options (define %default-options
@ -109,7 +114,9 @@
(_ #f)) (_ #f))
opts) opts)
#:per-job-parallelism #:per-job-parallelism
(assq-ref opts 'per-job-parallelism))) (assq-ref opts 'per-job-parallelism)
#:free-space-requirement
(assq-ref opts 'free-space-requirement)))
(lambda _ (lambda _
(backtrace)))) (backtrace))))
#:unwind? #t)))) #:unwind? #t))))