diff options
| -rw-r--r-- | guix/build/store-copy.scm | 31 | ||||
| -rw-r--r-- | 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)))) |