diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-05-31 15:23:51 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-06-02 18:47:07 +0200 |
| commit | 65f224dc8d9568232baa07f28474ba5c90f07428 (patch) | |
| tree | ff6a0f7e286d59600a5a3e289b355e454ef147fd | |
| parent | d9bad2f08296fa73b967973aa6648d24c100980f (diff) | |
| download | guix-65f224dc8d9568232baa07f28474ba5c90f07428.tar.gz | |
syscalls: Provide 'free-disk-space'.
* guix/build/syscalls.scm (free-disk-space): New procedure. * guix/scripts/gc.scm (guix-gc)[ensure-free-space]: Use it instead of 'statfs'.
| -rw-r--r-- | guix/build/syscalls.scm | 7 | ||||
| -rw-r--r-- | guix/scripts/gc.scm | 8 |
2 files changed, 10 insertions, 5 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 52439afd44..2def2a108f 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -62,6 +62,7 @@ file-system-fragment-size file-system-mount-flags statfs + free-disk-space processes mkdtemp! @@ -697,6 +698,12 @@ mounted at FILE." (list file (strerror err)) (list err))))))) +(define (free-disk-space file) + "Return the free disk space, in bytes, on the file system that hosts FILE." + (let ((fs (statfs file))) + (* (file-system-block-size fs) + (file-system-blocks-available fs)))) + ;;; ;;; Containers. diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 221467a108..0a9719d259 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +20,7 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix store) - #:autoload (guix build syscalls) (statfs) + #:autoload (guix build syscalls) (free-disk-space) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -184,9 +184,7 @@ Invoke the garbage collector.\n")) (define (ensure-free-space store space) ;; Attempt to have at least SPACE bytes available in STORE. - (let* ((fs (statfs (%store-prefix))) - (free (* (file-system-block-size fs) - (file-system-blocks-available fs)))) + (let ((free (free-disk-space (%store-prefix)))) (if (> free space) (info (G_ "already ~h bytes available on ~a, nothing to do~%") free (%store-prefix)) |