mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-05-27 03:21:49 +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:
+2
-1
@@ -736,7 +736,8 @@
|
||||
(zero? (logand #o222 (stat:mode st)))))))
|
||||
|
||||
(mkdir #$output)
|
||||
(populate-store '("graph") #$output)
|
||||
(populate-store '("graph") #$output
|
||||
#:deduplicate? #f)
|
||||
|
||||
;; Check whether 'populate-store' canonicalizes
|
||||
;; permissions and timestamps.
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -25,6 +25,7 @@
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-64))
|
||||
|
||||
(test-begin "store-deduplication")
|
||||
@@ -106,4 +107,19 @@
|
||||
(cons (apply = (map (compose stat:ino stat) identical))
|
||||
(map (compose stat:nlink stat) identical))))))
|
||||
|
||||
(test-assert "copy-file/deduplicate"
|
||||
(call-with-temporary-directory
|
||||
(lambda (store)
|
||||
(let ((source (search-path %load-path "gnu/packages/emacs-xyz.scm")))
|
||||
(for-each (lambda (target)
|
||||
(copy-file/deduplicate source
|
||||
(string-append store target)
|
||||
#:store store))
|
||||
'("/a" "/b" "/c"))
|
||||
(and (directory-exists? (string-append store "/.links"))
|
||||
(file=? source (string-append store "/a"))
|
||||
(apply = (map (compose stat:ino stat
|
||||
(cut string-append store <>))
|
||||
'("/a" "/b" "/c"))))))))
|
||||
|
||||
(test-end "store-deduplication")
|
||||
|
||||
Reference in New Issue
Block a user