From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:50452) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dG43d-0000sr-J1 for guix-patches@gnu.org; Wed, 31 May 2017 09:53:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dG43c-0002IL-B6 for guix-patches@gnu.org; Wed, 31 May 2017 09:53:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:43689) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dG43c-0002IH-7y for guix-patches@gnu.org; Wed, 31 May 2017 09:53:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dG43c-0001Lf-1O for guix-patches@gnu.org; Wed, 31 May 2017 09:53:04 -0400 Subject: bug#27162: [PATCH 4/6] syscalls: Provide 'free-disk-space'. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 31 May 2017 15:51:57 +0200 Message-Id: <20170531135159.8186-4-ludo@gnu.org> In-Reply-To: <20170531135159.8186-1-ludo@gnu.org> References: <20170531135159.8186-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 27162@debbugs.gnu.org * 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 +;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès ;;; ;;; 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