aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-31 15:23:51 +0200
committerLudovic Courtès <ludo@gnu.org>2017-06-02 18:47:07 +0200
commit65f224dc8d9568232baa07f28474ba5c90f07428 (patch)
treeff6a0f7e286d59600a5a3e289b355e454ef147fd
parentd9bad2f08296fa73b967973aa6648d24c100980f (diff)
downloadpatches-65f224dc8d9568232baa07f28474ba5c90f07428.tar
patches-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.scm7
-rw-r--r--guix/scripts/gc.scm8
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))