[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Mathieu Othacehe |
Date: |
Sun, 20 Nov 2022 12:32:59 -0500 (EST) |
branch: master
commit 06745e45adcb82e44db75c6c77c244650291098a
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Nov 20 18:18:06 2022 +0100
remote-worker: Use GiB thresholds.
* src/cuirass/scripts/remote-worker.scm (show-help, %options): Adapt them.
(%minimum-disk-space): Define if before %default-options in order to use it
to
set the default value. Use a 5GiB threshold because image builds that are
frequently failing due to the lack of space require a lot more than 100MiB.
---
src/cuirass/scripts/remote-worker.scm | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/src/cuirass/scripts/remote-worker.scm
b/src/cuirass/scripts/remote-worker.scm
index 26825a4..639c878 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -87,7 +87,7 @@ Start a remote build worker.\n" (%program-name))
-S, --systems=SYSTEMS list of supported SYSTEMS"))
(display (G_ "
--minimum-disk-space=THRESHOLD
- refuse builds if free space is below THRESHOLD
MiB"))
+ refuse builds if free space is below THRESHOLD
GiB"))
(display (G_ "
--substitute-urls=URLS
check for available substitutes at URLS"))
@@ -123,7 +123,7 @@ Start a remote build worker.\n" (%program-name))
(option '("minimum-disk-space") #t #f
(lambda (opt name arg result)
(alist-cons 'minimum-disk-space
- (* (string->number* arg) (expt 2 20))
+ (* (string->number* arg) (expt 2 30))
result)))
(option '(#\s "server") #t #f
(lambda (opt name arg result)
@@ -150,9 +150,14 @@ Start a remote build worker.\n" (%program-name))
(lambda (opt name arg result)
(alist-cons 'private-key-file arg result)))))
+(define %minimum-disk-space
+ ;; Minimum disk space required on the build machine before accepting more
+ ;; builds.
+ (make-parameter (* 5 (expt 2 30)))) ;5GiB
+
(define %default-options
`((workers . 1)
- (minimum-disk-space . (* 100 (expt 2 20)))
+ (minimum-disk-space . ,(%minimum-disk-space))
(publish-port . 5558)
(ttl . "1d")
(systems . ,(list (%current-system)))
@@ -288,11 +293,6 @@ command. REPLY is a procedure that can be used to reply
to this server."
(sleep 60)
(loop))))))
-(define %minimum-disk-space
- ;; Minimum disk space required on the build machine before accepting more
- ;; builds.
- (make-parameter (* 100 (expt 2 20))))
-
(define (low-disk-space?)
"Return true if disk space is low."
(or (< (free-disk-space (%store-prefix)) (%minimum-disk-space))