[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#27162: [PATCH 4/6] syscalls: Provide 'free-disk-space'.
From: |
Ludovic Courtès |
Subject: |
bug#27162: [PATCH 4/6] syscalls: Provide 'free-disk-space'. |
Date: |
Wed, 31 May 2017 15:51:57 +0200 |
* guix/build/syscalls.scm (free-disk-space): New procedure.
* guix/scripts/gc.scm (guix-gc)[ensure-free-space]: Use it instead of
'statfs'.
---
guix/build/syscalls.scm | 7 +++++++
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 52439afd4..2def2a108 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 221467a10..0a9719d25 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 <address@hidden>
+;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
;;;
;;; 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))
--
2.13.0