Make it possible to build GuixSD docker imagesdocker-system

1 files changed, 10 insertions, 4 deletions

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 7537f81509..19c47e1ffc 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -294,11 +294,14 @@ it, run its initializer, and unmount it."
 (define* (root-partition-initializer #:key (closures '())
                                      copy-closures?
                                      (register-closures? #t)
-                                     system-directory)
+                                     system-directory
+                                     (deduplicate? #t))
   "Return a procedure to initialize a root partition.
 
-If REGISTER-CLOSURES? is true, register all of CLOSURES is the partition's
-store.  If COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
+If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
+store.  If DEDUPLICATE? is true, then also deduplicate files common to
+CLOSURES and the rest of the store when registering the closures.  If
+COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
 SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
   (lambda (target)
     (define target-store
@@ -317,13 +320,16 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
       (unless copy-closures?
         ;; XXX: 'guix-register' wants to palpate the things it registers, so
         ;; bind-mount the store on the target.
+        (display "making target store directory\n")
         (mkdir-p target-store)
+        (display "bind-mounting\n")
         (mount (%store-directory) target-store "" MS_BIND))
 
       (display "registering closures...\n")
       (for-each (lambda (closure)
                   (register-closure target
-                                    (string-append "/xchg/" closure)))
+                                    (string-append "/xchg/" closure)
+                                    #:deduplicate? deduplicate?))
                 closures)
       (unless copy-closures?
         (umount target-store)))