summaryrefslogtreecommitdiff
path: root/guix/scripts.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-10-23 00:56:25 +0200
committerLudovic Courtès <ludo@gnu.org>2018-10-23 01:04:39 +0200
commit62a14bd26f2ed7cf416183528dcca4b1b29aaf0a (patch)
treeb9b19f8d467df3b3650d189fbe177ebd781a6bba /guix/scripts.scm
parent63abd1e2a36d48e1f8f7057a4c844b9cf5733be7 (diff)
scripts: Suggest running 'guix gc' when we're short on disk space.
* guix/scripts.scm (%disk-space-warning): New variable. (warn-about-disk-space): New procedure. * guix/scripts/package.scm (build-and-use-profile): Use it. * guix/scripts/system.scm (process-action): Likewise.
Diffstat (limited to 'guix/scripts.scm')
-rw-r--r--guix/scripts.scm38
1 files changed, 37 insertions, 1 deletions
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 98751bc812..5e20ecd92c 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -27,6 +27,7 @@
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module ((guix profiles) #:select (%profile-directory))
+ #:use-module (guix build syscalls)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-37)
@@ -37,7 +38,9 @@
build-package
build-package-source
%distro-age-warning
- warn-about-old-distro))
+ warn-about-old-distro
+ %disk-space-warning
+ warn-about-disk-space))
;;; Commentary:
;;;
@@ -186,4 +189,37 @@ Show what and how will/would be built."
suggested-command)
(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.)))))
+
+(define* (warn-about-disk-space #:optional profile
+ #:key
+ (threshold (%disk-space-warning)))
+ "Display a hint about 'guix gc' if less than THRESHOLD of /gnu/store is
+available."
+ (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))
+ (if profile
+ (display-hint (format #f (G_ "Consider deleting old profile
+generations and collecting garbage, along these lines:
+
+@example
+guix package -p ~s --delete-generations=1m
+guix gc
+@end example\n")
+ profile))
+ (display-hint (G_ "Consider running @command{guix gc} to free
+space."))))))
+
;;; scripts.scm ends here