ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-08 07:56:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
1 changed files with 7 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
guix/scripts/system.scm
View file

@ -148,12 +148,18 @@ (define* (copy-closure item target
"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")))