From 6a060ff27ff68384d7c90076baa36c349fff689d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
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'.
---
 tests/gexp.scm                |  3 ++-
 tests/store-deduplication.scm | 18 +++++++++++++++++-
 2 files changed, 19 insertions(+), 2 deletions(-)

(limited to 'tests')

diff --git a/tests/gexp.scm b/tests/gexp.scm
index a0e55178fa..6e92f0e4b3 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -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.
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index e2870a363d..7b01acae24 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -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")
-- 
cgit v1.2.1