mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-04-06 21:20:33 +02:00
store-copy: 'populate-store' can optionally deduplicate files.
Until now deduplication was performed as an additional pass after
copying files, which involve re-traversing all the files that had just
been copied.
* guix/store/deduplication.scm (copy-file/deduplicate): New procedure.
* tests/store-deduplication.scm ("copy-file/deduplicate"): New test.
* guix/build/store-copy.scm (populate-store): Add #:deduplicate?
parameter and honor it.
* tests/gexp.scm ("gexp->derivation, store copy"): Pass #:deduplicate? #f
to 'populate-store'.
* gnu/build/image.scm (initialize-root-partition): Pass #:deduplicate?
to 'populate-store'. Pass #:deduplicate? #f to 'register-closure'.
* gnu/build/vm.scm (root-partition-initializer): Likewise.
* gnu/build/install.scm (populate-single-profile-directory): Pass
#:deduplicate? #f to 'populate-store'.
* gnu/build/linux-initrd.scm (build-initrd): Likewise.
* guix/scripts/pack.scm (self-contained-tarball)[import-module?]: New
procedure.
[build]: Pass it as an argument to 'source-module-closure'.
* guix/scripts/pack.scm (squashfs-image)[build]: Wrap in
'with-extensions'.
* gnu/system/linux-initrd.scm (expression->initrd)[import-module?]: New
procedure.
[builder]: Pass it to 'source-module-closure'.
* gnu/system/install.scm (cow-store-service-type)[import-module?]: New
procedure. Pass it to 'source-module-closure'.
This commit is contained in:
@@ -186,7 +186,8 @@ rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
|
||||
of the directory of the 'system' derivation. Pass WAL-MODE? to
|
||||
register-closure."
|
||||
(populate-root-file-system system-directory root)
|
||||
(populate-store references-graphs root)
|
||||
(populate-store references-graphs root
|
||||
#:deduplicate? deduplicate?)
|
||||
|
||||
;; Populate /dev.
|
||||
(when make-device-nodes
|
||||
@@ -195,7 +196,7 @@ register-closure."
|
||||
(when register-closures?
|
||||
(for-each (lambda (closure)
|
||||
(register-closure root closure
|
||||
#:deduplicate? deduplicate?
|
||||
#:deduplicate? #f
|
||||
#:wal-mode? wal-mode?))
|
||||
references-graphs))
|
||||
|
||||
|
||||
@@ -214,7 +214,8 @@ This is used to create the self-contained tarballs with 'guix pack'."
|
||||
(symlink old (scope new)))
|
||||
|
||||
;; Populate the store.
|
||||
(populate-store (list closure) directory)
|
||||
(populate-store (list closure) directory
|
||||
#:deduplicate? #f)
|
||||
|
||||
(when database
|
||||
(install-database-and-gc-roots directory database profile
|
||||
|
||||
@@ -127,7 +127,8 @@ REFERENCES-GRAPHS."
|
||||
(mkdir "contents")
|
||||
|
||||
;; Copy the closures of all the items referenced in REFERENCES-GRAPHS.
|
||||
(populate-store references-graphs "contents")
|
||||
(populate-store references-graphs "contents"
|
||||
#:deduplicate? #f)
|
||||
|
||||
(with-directory-excursion "contents"
|
||||
;; Make '/init'.
|
||||
|
||||
@@ -395,7 +395,8 @@ system that is passed to 'populate-root-file-system'."
|
||||
(when copy-closures?
|
||||
;; Populate the store.
|
||||
(populate-store (map (cut string-append "/xchg/" <>) closures)
|
||||
target))
|
||||
target
|
||||
#:deduplicate? deduplicate?))
|
||||
|
||||
;; Populate /dev.
|
||||
(make-device-nodes target)
|
||||
@@ -412,7 +413,7 @@ system that is passed to 'populate-root-file-system'."
|
||||
(for-each (lambda (closure)
|
||||
(register-closure target
|
||||
(string-append "/xchg/" closure)
|
||||
#:deduplicate? deduplicate?))
|
||||
#:deduplicate? #f))
|
||||
closures)
|
||||
(unless copy-closures?
|
||||
(umount target-store)))
|
||||
|
||||
Reference in New Issue
Block a user