diff options
Diffstat (limited to 'guix/scripts.scm')
| -rw-r--r-- | guix/scripts.scm | 38 |
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 |