3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

guix system: init: Check the available space before copying.

* guix/scripts/system.scm (copy-closure): Call 'query-path-info*' on
TO-COPY and REFS.  Compute the total size.  Call 'check-available-space'.
This commit is contained in:
Ludovic Courtès 2018-07-02 23:59:52 +02:00
parent 8120b23e51
commit 71bf6cb700
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -148,12 +148,18 @@ REFERENCES as its set of references."
"Copy ITEM and all its dependencies to the store under root directory
TARGET, and register them."
(mlet* %store-monad ((to-copy (topologically-sorted* (list item)))
(refs (mapm %store-monad references* to-copy)))
(refs (mapm %store-monad references* to-copy))
(info (mapm %store-monad query-path-info*
(delete-duplicates
(append to-copy (concatenate refs)))))
(size -> (reduce + 0 (map path-info-nar-size info))))
(define progress-bar
(progress-reporter/bar (length to-copy)
(format #f (G_ "copying to '~a'...")
target)))
(check-available-space size target)
(call-with-progress-reporter progress-bar
(lambda (report)
(let ((void (%make-void-port "w")))