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'.
This commit is contained in:
parent
d9bad2f082
commit
65f224dc8d
|
@ -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.
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue