* bug#27162: [PATCH 2/6] derivations: 'derivation-prerequisites-to-build' returns <substitutable>.
2017-05-31 13:51 ` bug#27162: [PATCH 1/6] derivations: 'substitution-oracle' returns a <substitutable> Ludovic Courtès
@ 2017-05-31 13:51 ` Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 3/6] ui: 'show-what-to-build' displays how much will be downloaded Ludovic Courtès
` (3 subsequent siblings)
4 siblings, 0 replies; 13+ messages in thread
From: Ludovic Courtès @ 2017-05-31 13:51 UTC (permalink / raw)
To: 27162
* guix/derivations.scm (derivation-prerequisites-to-build): Rename
#:substitutable? to #:substitutable-info.
[derivation-substitutable?]: Rename to...
[derivation-substitutable-info]: ... this. Return a list of <substitutable>.
Second return value is now a list of <substitutable> instead of a list
of strings.
* guix/ui.scm (show-what-to-build)[substitutable?]: Rename to...
[substitutable-info]: ... this.
Adjust to new 'derivation-prerequisites-to-build' return value type.
* tests/derivations.scm ("derivation-prerequisites-to-build and
substitutes"): Adjust.
("derivation-prerequisites-to-build and substitutes, local build"):
Likewise.
---
guix/derivations.scm | 31 ++++++++++++++++++-------------
guix/ui.scm | 25 +++++++++++++++----------
tests/derivations.scm | 6 +++---
3 files changed, 36 insertions(+), 26 deletions(-)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 5e457f189..b9ad9c9e8 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -334,13 +334,13 @@ substituter many times."
(mode (build-mode normal))
(outputs
(derivation-output-names drv))
- (substitutable?
+ (substitutable-info
(substitution-oracle store
(list drv)
#:mode mode)))
"Return two values: the list of derivation-inputs required to build the
OUTPUTS of DRV and not already available in STORE, recursively, and the list
-of required store paths that can be substituted. SUBSTITUTABLE? must be a
+of required store paths that can be substituted. SUBSTITUTABLE-INFO must be a
one-argument procedure similar to that returned by 'substitution-oracle'."
(define built?
(cut valid-path? store <>))
@@ -351,7 +351,7 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
(define input-substitutable?
;; Return true if and only if all of SUB-DRVS are subsitutable. If at
;; least one is missing, then everything must be rebuilt.
- (compose (cut every substitutable? <>) derivation-input-output-paths))
+ (compose (cut every substitutable-info <>) derivation-input-output-paths))
(define (derivation-built? drv* sub-drvs)
;; In 'check' mode, assume that DRV is not built.
@@ -359,20 +359,24 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
(eq? drv* drv)))
(every built? (derivation-output-paths drv* sub-drvs))))
- (define (derivation-substitutable? drv sub-drvs)
+ (define (derivation-substitutable-info drv sub-drvs)
(and (substitutable-derivation? drv)
- (every substitutable? (derivation-output-paths drv sub-drvs))))
+ (let ((info (filter-map substitutable-info
+ (derivation-output-paths drv sub-drvs))))
+ (and (= (length info) (length sub-drvs))
+ info))))
(let loop ((drv drv)
(sub-drvs outputs)
- (build '())
- (substitute '()))
+ (build '()) ;list of <derivation-input>
+ (substitute '())) ;list of <substitutable>
(cond ((derivation-built? drv sub-drvs)
(values build substitute))
- ((derivation-substitutable? drv sub-drvs)
- (values build
- (append (derivation-output-paths drv sub-drvs)
- substitute)))
+ ((derivation-substitutable-info drv sub-drvs)
+ =>
+ (lambda (substitutables)
+ (values build
+ (append substitutables substitute))))
(else
(let ((build (if (substitutable-derivation? drv)
build
@@ -389,8 +393,9 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
(append (append-map (lambda (input)
(if (and (not (input-built? input))
(input-substitutable? input))
- (derivation-input-output-paths
- input)
+ (map substitutable-info
+ (derivation-input-output-paths
+ input))
'()))
(derivation-inputs drv))
substitute)
diff --git a/guix/ui.scm b/guix/ui.scm
index 9e0fa26d1..9b6464896 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -588,7 +588,7 @@ error."
derivations listed in DRV using MODE, a 'build-mode' value. Return #t if
there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and
report what is prerequisites are available for download."
- (define substitutable?
+ (define substitutable-info
;; Call 'substitutation-oracle' upfront so we don't end up launching the
;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'.
@@ -600,7 +600,7 @@ report what is prerequisites are available for download."
(or (null? (derivation-outputs drv))
(let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
(or (valid-path? store out)
- (substitutable? out)))))
+ (substitutable-info out)))))
(let*-values (((build download)
(fold2 (lambda (drv build download)
@@ -608,7 +608,8 @@ report what is prerequisites are available for download."
(derivation-prerequisites-to-build
store drv
#:mode mode
- #:substitutable? substitutable?)))
+ #:substitutable-info
+ substitutable-info)))
(values (append b build)
(append d download))))
'() '()
@@ -622,11 +623,13 @@ report what is prerequisites are available for download."
(if use-substitutes?
(delete-duplicates
(append download
- (remove (cut valid-path? store <>)
- (append-map
- substitutable-references
- (substitutable-path-info store
- download)))))
+ (filter-map (lambda (item)
+ (if (valid-path? store item)
+ #f
+ (substitutable-info item)))
+ (append-map
+ substitutable-references
+ download))))
download)))
;; TODO: Show the installed size of DOWNLOAD.
(if dry-run?
@@ -640,7 +643,8 @@ report what is prerequisites are available for download."
(N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]"
"~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
(length download))
- (null? download) download))
+ (null? download)
+ (map substitutable-path download)))
(begin
(format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
@@ -651,7 +655,8 @@ report what is prerequisites are available for download."
(N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]"
"~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
(length download))
- (null? download) download)))
+ (null? download)
+ (map substitutable-path download))))
(pair? build)))
(define show-what-to-build*
diff --git a/tests/derivations.scm b/tests/derivations.scm
index d4e1a32bb..f3aad1b90 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -831,10 +831,10 @@
(derivation-prerequisites-to-build store drv))
((build* download*)
(derivation-prerequisites-to-build store drv
- #:substitutable?
+ #:substitutable-info
(const #f))))
(and (null? build)
- (equal? download (list output))
+ (equal? (map substitutable-path download) (list output))
(null? download*)
(null? build*))))))
@@ -879,7 +879,7 @@
;; See <http://bugs.gnu.org/18747>.
(and (null? build)
(match download
- (((? string? item))
+ (((= substitutable-path item))
(string=? item (derivation->output-path drv))))))))))
(test-assert "derivation-prerequisites-to-build in 'check' mode"
--
2.13.0
^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#27162: [PATCH 3/6] ui: 'show-what-to-build' displays how much will be downloaded.
2017-05-31 13:51 ` bug#27162: [PATCH 1/6] derivations: 'substitution-oracle' returns a <substitutable> Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 2/6] derivations: 'derivation-prerequisites-to-build' returns <substitutable> Ludovic Courtès
@ 2017-05-31 13:51 ` Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 4/6] syscalls: Provide 'free-disk-space' Ludovic Courtès
` (2 subsequent siblings)
4 siblings, 0 replies; 13+ messages in thread
From: Ludovic Courtès @ 2017-05-31 13:51 UTC (permalink / raw)
To: 27162
* guix/ui.scm (show-what-to-build)[download-size]
[display-download-size?]: New variables.
Add cases for when DISPLAY-DOWNLOAD-SIZE? is true.
---
guix/ui.scm | 49 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 37 insertions(+), 12 deletions(-)
diff --git a/guix/ui.scm b/guix/ui.scm
index 9b6464896..04c7463fb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -632,6 +632,15 @@ report what is prerequisites are available for download."
download))))
download)))
;; TODO: Show the installed size of DOWNLOAD.
+ (define download-size
+ (/ (reduce + 0 (map substitutable-download-size download))
+ 1e6))
+
+ (define display-download-size?
+ ;; Sometimes narinfos lack information about the download size. Only
+ ;; display when we have information for all of DOWNLOAD.
+ (any (compose zero? substitutable-download-size) download))
+
(if dry-run?
(begin
(format (current-error-port)
@@ -639,24 +648,40 @@ report what is prerequisites are available for download."
"~:[The following derivations would be built:~%~{ ~a~%~}~;~]"
(length build))
(null? build) build)
- (format (current-error-port)
- (N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]"
- "~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
- (length download))
- (null? download)
- (map substitutable-path download)))
+ (if display-download-size?
+ (format (current-error-port)
+ ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+ ;; translated to the corresponding abbreviation.
+ (G_ "~:[~,1h MB would be downloaded:~%~{ ~a~%~}~;~]")
+ (null? download)
+ download-size
+ (map substitutable-path download))
+ (format (current-error-port)
+ (N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]"
+ "~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
+ (length download))
+ (null? download)
+ (map substitutable-path download))))
(begin
(format (current-error-port)
(N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
"~:[The following derivations will be built:~%~{ ~a~%~}~;~]"
(length build))
(null? build) build)
- (format (current-error-port)
- (N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]"
- "~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
- (length download))
- (null? download)
- (map substitutable-path download))))
+ (if display-download-size?
+ (format (current-error-port)
+ ;; TRANSLATORS: "MB" is for "megabyte"; it should be
+ ;; translated to the corresponding abbreviation.
+ (G_ "~:[~,1h MB will be downloaded:~%~{ ~a~%~}~;~]")
+ (null? download)
+ download-size
+ (map substitutable-path download))
+ (format (current-error-port)
+ (N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]"
+ "~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
+ (length download))
+ (null? download)
+ (map substitutable-path download)))))
(pair? build)))
(define show-what-to-build*
--
2.13.0
^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#27162: [PATCH 4/6] syscalls: Provide 'free-disk-space'.
2017-05-31 13:51 ` bug#27162: [PATCH 1/6] derivations: 'substitution-oracle' returns a <substitutable> Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 2/6] derivations: 'derivation-prerequisites-to-build' returns <substitutable> Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 3/6] ui: 'show-what-to-build' displays how much will be downloaded Ludovic Courtès
@ 2017-05-31 13:51 ` Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 5/6] ui: 'show-what-to-build' warns when we don't have enough disk space Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 6/6] substitute: Do not display the installed size Ludovic Courtès
4 siblings, 0 replies; 13+ messages in thread
From: Ludovic Courtès @ 2017-05-31 13:51 UTC (permalink / raw)
To: 27162
* 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))))
+
\f
;;;
;;; 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 <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))
--
2.13.0
^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#27162: [PATCH 5/6] ui: 'show-what-to-build' warns when we don't have enough disk space.
2017-05-31 13:51 ` bug#27162: [PATCH 1/6] derivations: 'substitution-oracle' returns a <substitutable> Ludovic Courtès
` (2 preceding siblings ...)
2017-05-31 13:51 ` bug#27162: [PATCH 4/6] syscalls: Provide 'free-disk-space' Ludovic Courtès
@ 2017-05-31 13:51 ` Ludovic Courtès
2017-05-31 13:51 ` bug#27162: [PATCH 6/6] substitute: Do not display the installed size Ludovic Courtès
4 siblings, 0 replies; 13+ messages in thread
From: Ludovic Courtès @ 2017-05-31 13:51 UTC (permalink / raw)
To: 27162
* 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
^ permalink raw reply related [flat|nested] 13+ messages in thread
* bug#27162: [PATCH 6/6] substitute: Do not display the installed size.
2017-05-31 13:51 ` bug#27162: [PATCH 1/6] derivations: 'substitution-oracle' returns a <substitutable> Ludovic Courtès
` (3 preceding siblings ...)
2017-05-31 13:51 ` bug#27162: [PATCH 5/6] ui: 'show-what-to-build' warns when we don't have enough disk space Ludovic Courtès
@ 2017-05-31 13:51 ` Ludovic Courtès
4 siblings, 0 replies; 13+ messages in thread
From: Ludovic Courtès @ 2017-05-31 13:51 UTC (permalink / raw)
To: 27162
* guix/scripts/substitute.scm (process-substitution): Do not show the
installed size in the "Downloading" message.
---
guix/scripts/substitute.scm | 10 +---------
1 file changed, 1 insertion(+), 9 deletions(-)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 4ee15ba67..71f30030b 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -874,15 +874,7 @@ DESTINATION as a nar file. Verify the substitute against ACL."
(format #t "~a~%" (narinfo-hash narinfo))
(format (current-error-port)
- ;; TRANSLATORS: The second part of this message looks like
- ;; "(4.1MiB installed)"; it shows the size of the package once
- ;; installed.
- (G_ "Downloading ~a~:[~*~; (~a installed)~]...~%")
- (uri->string uri)
- ;; Use the Nar size as an estimate of the installed size.
- (narinfo-size narinfo)
- (and=> (narinfo-size narinfo)
- (cute byte-count->string <>)))
+ (G_ "Downloading ~a...~%") (uri->string uri))
(let*-values (((raw download-size)
;; Note that Hydra currently generates Nars on the fly
;; and doesn't specify a Content-Length, so
--
2.13.0
^ permalink raw reply related [flat|nested] 13+ messages in thread