06/08: syscalls: Provide 'free-disk-space'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 65f224dc8d9568232baa07f28474ba5c90f07428
Author: Ludovic Courtès <address@hidden>
Date:   Wed May 31 15:23:51 2017 +0200

    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'.
---
 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 52439af..2def2a1 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 221467a..0a9719d 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))