From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:50469) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dG43e-0000tB-4U 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-0002Ij-Rn for guix-patches@gnu.org; Wed, 31 May 2017 09:53:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:43690) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dG43c-0002IY-Nx 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-0001Ln-H6 for guix-patches@gnu.org; Wed, 31 May 2017 09:53:04 -0400 Subject: bug#27162: [PATCH 5/6] ui: 'show-what-to-build' warns when we don't have enough disk space. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 31 May 2017 15:51:58 +0200 Message-Id: <20170531135159.8186-5-ludo@gnu.org> In-Reply-To: <20170531135159.8186-1-ludo@gnu.org> References: <20170531135159.8186-1-ludo@gnu.org> 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/ui.scm (check-available-space): New procedure. (show-what-to-build): Compute 'installed-size' and call 'check-available-space'. --- guix/ui.scm | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/guix/ui.scm b/guix/ui.scm index 04c7463fb..0e47a200c 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -38,7 +38,8 @@ #:use-module (guix serialization) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix licenses) #:select (license? license-name)) - #:use-module ((guix build syscalls) #:select (terminal-columns)) + #:use-module ((guix build syscalls) + #:select (free-disk-space terminal-columns)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -581,6 +582,17 @@ error." (derivation->output-path derivation out-name))) (derivation-outputs derivation)))) +(define (check-available-space need) + "Make sure at least NEED bytes are available in the store. Otherwise emit a +warning." + (let ((free (catch 'system-error + (lambda () + (free-disk-space (%store-prefix))) + (const #f)))) + (when (and free (>= need free)) + (warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%") + (/ need 1e6) (/ free 1e6) (%store-prefix))))) + (define* (show-what-to-build store drv #:key dry-run? (use-substitutes? #t) (mode (build-mode normal))) @@ -631,7 +643,9 @@ report what is prerequisites are available for download." substitutable-references download)))) download))) - ;; TODO: Show the installed size of DOWNLOAD. + (define installed-size + (reduce + 0 (map substitutable-nar-size download))) + (define download-size (/ (reduce + 0 (map substitutable-download-size download)) 1e6)) @@ -682,6 +696,9 @@ report what is prerequisites are available for download." (length download)) (null? download) (map substitutable-path download))))) + + (check-available-space installed-size) + (pair? build))) (define show-what-to-build* -- 2.13.0