aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-19 22:42:34 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-19 23:52:40 +0200
commitc56d19fb113d96a5af7c6d0500d256e633fe3eb9 (patch)
treea028d7fffb6235ad9e4619659c8b82c1e5ccea57
parentd467e640aa763e3440231270c832028b5c804a6a (diff)
downloadpatches-c56d19fb113d96a5af7c6d0500d256e633fe3eb9.tar
patches-c56d19fb113d96a5af7c6d0500d256e633fe3eb9.tar.gz
guix system: Factorize out closure copy.
* guix/scripts/system.scm (copy-closure): New procedure. (install): Use it.
-rw-r--r--guix/scripts/system.scm30
1 files changed, 17 insertions, 13 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index c02ad36c09..78bff28112 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -70,6 +70,22 @@
(leave (_ "failed to load machine file '~a': ~s~%")
file args))))))
+(define* (copy-closure store item target
+ #:key (log-port (current-error-port)))
+ "Copy ITEM to the store under root directory TARGET and register it."
+ (let ((dest (string-append target item))
+ (refs (references store item)))
+ (format log-port "copying '~a'...~%" item)
+ (copy-recursively item dest
+ #:log (%make-void-port "w"))
+
+ ;; Register ITEM; as a side-effect, it resets timestamps, etc.
+ (unless (register-path item
+ #:prefix target
+ #:references refs)
+ (leave (_ "failed to register '~a' under '~a'~%")
+ item target))))
+
(define* (install store os-dir target
#:key (log-port (current-output-port))
grub? grub.cfg device)
@@ -83,19 +99,7 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
(topologically-sorted store lst)))
;; Copy items to the new store.
- (for-each (lambda (item)
- (let ((dest (string-append target item))
- (refs (references store item)))
- (format log-port "copying '~a'...~%" item)
- (copy-recursively item dest
- #:log (%make-void-port "w"))
-
- ;; Register ITEM; as a side-effect, it resets timestamps, etc.
- (unless (register-path item
- #:prefix target
- #:references refs)
- (leave (_ "failed to register '~a' under '~a'~%")
- item target))))
+ (for-each (cut copy-closure store <> target #:log-port log-port)
to-copy)
;; Create a bunch of additional files.