unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 44760@debbugs.gnu.org
Subject: bug#44760: [PATCH 10/15] guix system: 'init' copies, resets timestamps, and deduplicates at once.
Date: Fri, 11 Dec 2020 16:09:46 +0100	[thread overview]
Message-ID: <20201211150951.18508-1-ludo@gnu.org> (raw)
In-Reply-To: <87h7pkffzy.fsf@inria.fr>

Partly fixes <https://bugs.gnu.org/44760>.

* guix/build/store-copy.scm (copy-store-item): New procedure.
(populate-store): Use it instead of the inline 'copy-recursively' call.
* guix/scripts/system.scm (copy-item): Likewise.
Pass #:reset-timestamps? and #:deduplicate? to 'register-path'.
---
 guix/build/store-copy.scm | 31 +++++++++++++++++++++----------
 guix/scripts/system.scm   | 11 ++++++++---
 2 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm
index 7f0672cd9d..01e1f41870 100644
--- a/guix/build/store-copy.scm
+++ b/guix/build/store-copy.scm
@@ -38,6 +38,7 @@
 
             file-size
             closure-size
+            copy-store-item
             populate-store))
 
 ;;; Commentary:
@@ -242,6 +243,24 @@ permissions.  Write verbose output to the LOG port."
                         stat
                         lstat)))
 
+(define* (copy-store-item item target
+                          #:key
+                          (deduplicate? #t)
+                          (log-port (%make-void-port "w")))
+  "Copy ITEM, a store item, to the store under TARGET, the target root
+directory.  When DEDUPLICATE? is true, deduplicate it within TARGET."
+  (define store
+    (string-append target (%store-directory)))
+
+  (copy-recursively item (string-append target item)
+                    #:keep-mtime? #t
+                    #:keep-permissions? #t
+                    #:copy-file
+                    (if deduplicate?
+                        (cut copy-file/deduplicate <> <> #:store store)
+                        copy-file)
+                    #:log log-port))
+
 (define* (populate-store reference-graphs target
                          #:key
                          (deduplicate? #t)
@@ -273,16 +292,8 @@ regular files as they are copied to TARGET."
     (call-with-progress-reporter progress
       (lambda (report)
         (for-each (lambda (thing)
-                    (copy-recursively thing
-                                      (string-append target thing)
-                                      #:keep-mtime? #t
-                                      #:keep-permissions? #t
-                                      #:copy-file
-                                      (if deduplicate?
-                                          (cut copy-file/deduplicate <> <>
-                                               #:store store)
-                                          copy-file)
-                                      #:log (%make-void-port "w"))
+                    (copy-store-item thing target
+                                     #:deduplicate? deduplicate?)
                     (report))
                   things)))))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index db80e0be8f..c08929066b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -30,6 +30,7 @@
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module (guix store)
   #:autoload   (guix store database) (register-path)
+  #:autoload   (guix build store-copy) (copy-store-item)
   #:use-module (guix describe)
   #:use-module (guix grafts)
   #:use-module (guix gexp)
@@ -147,8 +148,8 @@ REFERENCES as its set of references."
                             #:directories? #t))
       (delete-file-recursively dest))
 
-    (copy-recursively item dest
-                      #:log (%make-void-port "w"))
+    (copy-store-item item target
+                     #:deduplicate? #t)
 
     ;; Register ITEM; as a side-effect, it resets timestamps, etc.
     ;; Explicitly use "TARGET/var/guix" as the state directory, to avoid
@@ -157,7 +158,11 @@ REFERENCES as its set of references."
     (unless (register-path item
                            #:prefix target
                            #:state-directory state
-                           #:references references)
+                           #:references references
+
+                           ;; Those are taken care of by 'copy-store-item'.
+                           #:reset-timestamps? #f
+                           #:deduplicate? #f)
       (leave (G_ "failed to register '~a' under '~a'~%")
              item target))))
 
-- 
2.29.2





  parent reply	other threads:[~2020-12-11 15:11 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-11-20 11:02 bug#44760: Closure copy in ‘guix system init’ is inefficient Ludovic Courtès
2020-11-22 19:46 ` raingloom
2020-11-22 21:10   ` Ludovic Courtès
2020-12-11 15:09 ` bug#44760: [PATCH 00/15] Speed up 'guix system init' & co Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 01/15] serialization: 'fold-archive' notifies about directory processing completion Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 02/15] serialization: 'restore-file' sets canonical timestamp and permissions Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 03/15] nar: Deduplicate files right as they are restored Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 04/15] store-copy: 'populate-store' resets timestamps Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 05/15] image: 'register-closure' assumes already-reset timestamps Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 06/15] database: Remove #:reset-timestamps? from 'register-items' Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 07/15] store-copy: 'populate-store' can optionally deduplicate files Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 08/15] image: 'register-closure' leaves it up to the caller to deduplicate Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 09/15] database: Remove #:deduplicate? from 'register-items' Ludovic Courtès
2020-12-15 16:33   ` bug#44760: [PATCH 00/15] Speed up 'guix system init' & co Ludovic Courtès
2020-12-11 15:09 ` Ludovic Courtès [this message]
2020-12-11 15:09   ` bug#44760: [PATCH 11/15] database: Remove #:deduplicate? and #:reset-timestamps? from 'register-path' Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 12/15] system: 'init' does not recompute the hash of each store item Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 13/15] database: Remove 'register-path' Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 14/15] database: Honor 'SOURCE_DATE_EPOCH' Ludovic Courtès
2020-12-11 15:09   ` bug#44760: [PATCH 15/15] deduplicate: Create the '.links' directory lazily Ludovic Courtès
2020-12-15 16:38 ` bug#44760: Closure copy in ‘guix system init’ is inefficient Ludovic Courtès
2020-12-16 21:53 ` Jonathan Brielmaier
2020-12-17 13:24   ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20201211150951.18508-1-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=44760@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).