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'. --- gnu/build/image.scm | 5 +++-- gnu/build/install.scm | 3 ++- gnu/build/linux-initrd.scm | 3 ++- gnu/build/vm.scm | 5 +++-- gnu/system/install.scm | 12 ++++++++++-- gnu/system/linux-initrd.scm | 10 +++++++++- 6 files changed, 29 insertions(+), 9 deletions(-) (limited to 'gnu') diff --git a/gnu/build/image.scm b/gnu/build/image.scm index 0deea10a9d..8f50f27f78 100644 --- a/gnu/build/image.scm +++ b/gnu/build/image.scm @@ -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)) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 63995e1d09..f5c8407b89 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -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 diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index 99796adba6..bb2ed0db0c 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -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'. diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index abb0317faf..03be5697b7 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -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))) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index a6b9e3d952..e753463473 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016 Andreas Enge ;;; Copyright © 2017 Marius Bakke @@ -176,6 +176,13 @@ manual." (shepherd-service-type 'cow-store (lambda _ + (define (import-module? module) + ;; Since we don't use deduplication support in 'populate-store', don't + ;; import (guix store deduplication) and its dependencies, which + ;; includes Guile-Gcrypt. + (and (guix-module-name? module) + (not (equal? module '(guix store deduplication))))) + (shepherd-service (requirement '(root-file-system user-processes)) (provision '(cow-store)) @@ -190,7 +197,8 @@ the given target.") ,@%default-modules)) (start (with-imported-modules (source-module-closure - '((gnu build install))) + '((gnu build install)) + #:select? import-module?) #~(case-lambda ((target) (mount-cow-store target #$%backing-directory) diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 4fb1d863c9..c6ba9bb560 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -76,12 +76,20 @@ the derivations referenced by EXP are automatically copied to the initrd." (define init (program-file "init" exp #:guile guile)) + (define (import-module? module) + ;; Since we don't use deduplication support in 'populate-store', don't + ;; import (guix store deduplication) and its dependencies, which includes + ;; Guile-Gcrypt. That way we can run tests with '--bootstrap'. + (and (guix-module-name? module) + (not (equal? module '(guix store deduplication))))) + (define builder ;; Do not use "guile-zlib" extension here, otherwise it would drag the ;; non-static "zlib" package to the initrd closure. It is not needed ;; anyway because the modules are stored uncompressed within the initrd. (with-imported-modules (source-module-closure - '((gnu build linux-initrd))) + '((gnu build linux-initrd)) + #:select? import-module?) #~(begin (use-modules (gnu build linux-initrd)) -- cgit v1.2.3