guix system: 'init' copies, resets timestamps, and deduplicates at once.
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:
		
							parent
							
								
									0793833c59
								
							
						
					
					
						commit
						cd6c5ddfc8
					
				
					 2 changed files with 29 additions and 13 deletions
				
			
		| 
						 | 
				
			
			@ -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)))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue