[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than ab
From: |
Pierre Neidhardt |
Subject: |
[bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold. |
Date: |
Mon, 24 Feb 2020 08:51:52 +0100 |
* guix/scripts.scm (%disk-space-warning-absolute): New variable.
(warn-about-disk-space): Test against %disk-space-warning-absolute.
Fix error in display-hint due to extraneous 'profile' argument.
---
guix/scripts.scm | 59 ++++++++++++++++++++++++++++++++++++------------
1 file changed, 45 insertions(+), 14 deletions(-)
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 77cbf12350..bfb378f93c 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -181,32 +181,63 @@ Show what and how will/would be built."
(newline (guix-warning-port))))
(define %disk-space-warning
- ;; The fraction (between 0 and 1) of free disk space below which a warning
- ;; is emitted.
- (make-parameter (match (and=> (getenv "GUIX_DISK_SPACE_WARNING")
- string->number)
- (#f .05) ;5%
- (threshold (/ threshold 100.)))))
+ ;; Return a pair of absolute threshold (number of bytes) and relative
+ ;; threshold (fraction between 0 and 1) for the free disk space below which
+ ;; a warning is emitted.
+ ;; GUIX_DISK_SPACE_WARNING can contain both thresholds. The following
+ ;; example values are valid:
+ ;; - 1GiB;10% ;1 GiB absolute, and 10% relative.
+ ;; - 15G ;15 absolute, and default relative.
+ ;; - 15% ;15% relative, and default absolute.
+ (let* ((default-absolute-threshold (size->number "5GiB"))
+ (default-relative-threshold 0.05)
+ (percentage->float (lambda (percentage)
+ (or (if (string? percentage)
+ (string->number
+ (car (string-split percentage #\%))))
+ default-relative-threshold)))
+ (size->number* (lambda (size)
+ (or (false-if-exception (size->number size))
+ default-absolute-threshold))))
+ (make-parameter
+ (match (getenv "GUIX_DISK_SPACE_WARNING")
+ (#f (list default-absolute-threshold
+ default-relative-threshold))
+ (env-string (match (string-split env-string #\;)
+ ((threshold)
+ (if (string-contains threshold "%")
+ (list default-absolute-threshold
+ (percentage->float threshold))
+ (list (size->number* threshold)
+ default-relative-threshold)))
+ ((threshold1 threshold2)
+ (if (string-contains threshold1 "%")
+ (list (size->number* threshold2)
+ (percentage->float threshold1))
+ (list (size->number* threshold1)
+ (percentage->float threshold2))))))))))
(define* (warn-about-disk-space #:optional profile
#:key
- (threshold (%disk-space-warning)))
+ (thresholds (%disk-space-warning)))
"Display a hint about 'guix gc' if less than THRESHOLD of /gnu/store is
-available."
+available.
+THRESHOLD is a pair of (ABSOLUTE-THRESHOLD RELATIVE-THRESHOLD)."
(let* ((stats (statfs (%store-prefix)))
(block-size (file-system-block-size stats))
(available (* block-size (file-system-blocks-available stats)))
(total (* block-size (file-system-block-count stats)))
- (ratio (/ available total 1.)))
- (when (< ratio threshold)
- (warning (G_ "only ~,1f% of free space available on ~a~%")
- (* ratio 100) (%store-prefix))
+ (relative-threshold-in-bytes (* total (cadr thresholds)))
+ (absolute-threshold-in-bytes (* 1024 1024 1024 (car thresholds))))
+ (when (< available (min relative-threshold-in-bytes
+ absolute-threshold-in-bytes))
+ (warning (G_ "only ~,1f GiB of free space available on ~a~%")
+ available (%store-prefix))
(display-hint (format #f (G_ "Consider deleting old profile
generations and collecting garbage, along these lines:
@example
guix gc --delete-generations=1m
-@end example\n")
- profile)))))
+@end example\n"))))))
;;; scripts.scm ends here
--
2.25.0
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., (continued)
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Ludovic Courtès, 2020/02/24
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Pierre Neidhardt, 2020/02/24
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Pierre Neidhardt, 2020/02/24
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Ludovic Courtès, 2020/02/24
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Pierre Neidhardt, 2020/02/25
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Pierre Neidhardt, 2020/02/25
- bug#39734: [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Ludovic Courtès, 2020/02/26
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Pierre Neidhardt, 2020/02/24
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Ludovic Courtès, 2020/02/23
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold., Pierre Neidhardt, 2020/02/24
- [bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold.,
Pierre Neidhardt <=