nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2017-05-31 15:23:51 +02:00
parent d9bad2f082
commit 65f224dc8d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
guix/build/syscalls.scm
View File

@ -62,6 +62,7 @@
file-system-fragment-size file-system-fragment-size
file-system-mount-flags file-system-mount-flags
statfs statfs
free-disk-space
processes processes
mkdtemp! mkdtemp!
@ -697,6 +698,12 @@ mounted at FILE."
(list file (strerror err)) (list file (strerror err))
(list 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. ;;; Containers.

8
guix/scripts/gc.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,7 +20,7 @@
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix store) #: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 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -184,9 +184,7 @@ Invoke the garbage collector.\n"))
(define (ensure-free-space store space) (define (ensure-free-space store space)
;; Attempt to have at least SPACE bytes available in STORE. ;; Attempt to have at least SPACE bytes available in STORE.
(let* ((fs (statfs (%store-prefix))) (let ((free (free-disk-space (%store-prefix))))
(free (* (file-system-block-size fs)
(file-system-blocks-available fs))))
(if (> free space) (if (> free space)
(info (G_ "already ~h bytes available on ~a, nothing to do~%") (info (G_ "already ~h bytes available on ~a, nothing to do~%")
free (%store-prefix)) free (%store-prefix))