mirror of git://git.savannah.gnu.org/guix.git
guix system: 'init' copies, resets timestamps, and deduplicates at once.
Partly fixes <https://bugs.gnu.org/44760>. * guix/build/store-copy.scm (copy-store-item): New procedure. (populate-store): Use it instead of the inline 'copy-recursively' call. * guix/scripts/system.scm (copy-item): Likewise. Pass #:reset-timestamps? and #:deduplicate? to 'register-path'.
This commit is contained in:
parent
0793833c59
commit
cd6c5ddfc8
|
@ -38,6 +38,7 @@
|
|||
|
||||
file-size
|
||||
closure-size
|
||||
copy-store-item
|
||||
populate-store))
|
||||
|
||||
;;; Commentary:
|
||||
|
@ -242,6 +243,24 @@ permissions. Write verbose output to the LOG port."
|
|||
stat
|
||||
lstat)))
|
||||
|
||||
(define* (copy-store-item item target
|
||||
#:key
|
||||
(deduplicate? #t)
|
||||
(log-port (%make-void-port "w")))
|
||||
"Copy ITEM, a store item, to the store under TARGET, the target root
|
||||
directory. When DEDUPLICATE? is true, deduplicate it within TARGET."
|
||||
(define store
|
||||
(string-append target (%store-directory)))
|
||||
|
||||
(copy-recursively item (string-append target item)
|
||||
#:keep-mtime? #t
|
||||
#:keep-permissions? #t
|
||||
#:copy-file
|
||||
(if deduplicate?
|
||||
(cut copy-file/deduplicate <> <> #:store store)
|
||||
copy-file)
|
||||
#:log log-port))
|
||||
|
||||
(define* (populate-store reference-graphs target
|
||||
#:key
|
||||
(deduplicate? #t)
|
||||
|
@ -273,16 +292,8 @@ regular files as they are copied to TARGET."
|
|||
(call-with-progress-reporter progress
|
||||
(lambda (report)
|
||||
(for-each (lambda (thing)
|
||||
(copy-recursively thing
|
||||
(string-append target thing)
|
||||
#:keep-mtime? #t
|
||||
#:keep-permissions? #t
|
||||
#:copy-file
|
||||
(if deduplicate?
|
||||
(cut copy-file/deduplicate <> <>
|
||||
#:store store)
|
||||
copy-file)
|
||||
#:log (%make-void-port "w"))
|
||||
(copy-store-item thing target
|
||||
#:deduplicate? deduplicate?)
|
||||
(report))
|
||||
things)))))
|
||||
|
||||
|
|
|
@ -30,6 +30,7 @@
|
|||
#:use-module ((guix status) #:select (with-status-verbosity))
|
||||
#:use-module (guix store)
|
||||
#:autoload (guix store database) (register-path)
|
||||
#:autoload (guix build store-copy) (copy-store-item)
|
||||
#:use-module (guix describe)
|
||||
#:use-module (guix grafts)
|
||||
#:use-module (guix gexp)
|
||||
|
@ -147,8 +148,8 @@ REFERENCES as its set of references."
|
|||
#:directories? #t))
|
||||
(delete-file-recursively dest))
|
||||
|
||||
(copy-recursively item dest
|
||||
#:log (%make-void-port "w"))
|
||||
(copy-store-item item target
|
||||
#:deduplicate? #t)
|
||||
|
||||
;; Register ITEM; as a side-effect, it resets timestamps, etc.
|
||||
;; Explicitly use "TARGET/var/guix" as the state directory, to avoid
|
||||
|
@ -157,7 +158,11 @@ REFERENCES as its set of references."
|
|||
(unless (register-path item
|
||||
#:prefix target
|
||||
#:state-directory state
|
||||
#:references references)
|
||||
#:references references
|
||||
|
||||
;; Those are taken care of by 'copy-store-item'.
|
||||
#:reset-timestamps? #f
|
||||
#:deduplicate? #f)
|
||||
(leave (G_ "failed to register '~a' under '~a'~%")
|
||||
item target))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue