diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-05-19 22:42:34 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-05-19 23:52:40 +0200 |
| commit | c56d19fb113d96a5af7c6d0500d256e633fe3eb9 (patch) | |
| tree | a028d7fffb6235ad9e4619659c8b82c1e5ccea57 | |
| parent | d467e640aa763e3440231270c832028b5c804a6a (diff) | |
guix system: Factorize out closure copy.
* guix/scripts/system.scm (copy-closure): New procedure.
(install): Use it.
| -rw-r--r-- | guix/scripts/system.scm | 30 |
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. |