me/guix
Archived
1
0
Fork 0
Code Activity

guix system: 'init' copies, resets timestamps, and deduplicates at once.

Browse source 
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'.
This commit is contained in:
Ludovic Courtès 2020-12-11 10:37:06 +01:00
parent 0793833c59
commit cd6c5ddfc8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 29 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
guix/build/store-copy.scm
View file

@ -38,6 +38,7 @@
file-size file-size
closure-size closure-size
copy-store-item
populate-store)) populate-store))
;;; Commentary: ;;; Commentary:
@ -242,6 +243,24 @@ permissions. Write verbose output to the LOG port."
stat stat
lstat))) 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 (define* (populate-store reference-graphs target
#:key #:key
(deduplicate? #t) (deduplicate? #t)
@ -273,16 +292,8 @@ regular files as they are copied to TARGET."
(call-with-progress-reporter progress (call-with-progress-reporter progress
(lambda (report) (lambda (report)
(for-each (lambda (thing) (for-each (lambda (thing)
(copy-recursively thing (copy-store-item thing target
(string-append target thing) #:deduplicate? deduplicate?)
#:keep-mtime? #t
#:keep-permissions? #t
#:copy-file
(if deduplicate?
(cut copy-file/deduplicate <> <>
#:store store)
copy-file)
#:log (%make-void-port "w"))
(report)) (report))
things))))) things)))))

11
guix/scripts/system.scm
View file

@ -30,6 +30,7 @@
#:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix store) #:use-module (guix store)
#:autoload (guix store database) (register-path) #:autoload (guix store database) (register-path)
#:autoload (guix build store-copy) (copy-store-item)
#:use-module (guix describe) #:use-module (guix describe)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -147,8 +148,8 @@ REFERENCES as its set of references."
#:directories? #t)) #:directories? #t))
(delete-file-recursively dest)) (delete-file-recursively dest))
(copy-recursively item dest (copy-store-item item target
#:log (%make-void-port "w")) #:deduplicate? #t)
;; Register ITEM; as a side-effect, it resets timestamps, etc. ;; Register ITEM; as a side-effect, it resets timestamps, etc.
;; Explicitly use "TARGET/var/guix" as the state directory, to avoid ;; 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 (unless (register-path item
#:prefix target #:prefix target
#:state-directory state #: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'~%") (leave (G_ "failed to register '~a' under '~a'~%")
item target)))) item target))))