From 6a060ff27ff68384d7c90076baa36c349fff689d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 10 Dec 2020 15:12:34 +0100 Subject: 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'. --- guix/store/deduplication.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'guix/store') diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index b4d37d4525..8564f12107 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -34,7 +34,8 @@ #:use-module (guix serialization) #:export (nar-sha256 deduplicate - dump-file/deduplicate)) + dump-file/deduplicate + copy-file/deduplicate)) ;; XXX: This port is used as a workaround on Guile <= 2.2.4 where ;; 'port-position' throws to 'out-of-range' when the offset is great than or @@ -256,3 +257,16 @@ down the road." (get-hash))))) (deduplicate file hash #:store store)) + +(define* (copy-file/deduplicate source target + #:key (store (%store-directory))) + "Like 'copy-file', but additionally deduplicate TARGET in STORE." + (call-with-input-file source + (lambda (input) + (let ((stat (stat input))) + (dump-file/deduplicate target input (stat:size stat) + (if (zero? (logand (stat:mode stat) + #o100)) + 'regular + 'executable) + #:store store))))) -- cgit v1.2.3