diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-12-11 12:36:52 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-12-15 17:32:11 +0100 |
commit | 1574bd82bb36ee64574912c3e8855f94a73adc44 (patch) | |
tree | 180ad6f175671dc197fc73ccbaf49e1f2eb22650 /guix | |
parent | 0682cc593688e7d9a435ca69f05320aa87df06d0 (diff) |
system: 'init' does not recompute the hash of each store item.
Fixes <https://bugs.gnu.org/44760>.
Previously, the 'register-path' call would re-traverse ITEM to compute
its nar hash, even though that hash is already known in the initial
store. This patch also avoids repeated opening/closing of the
database.
* guix/store/database.scm (call-with-database): Export.
* guix/scripts/system.scm (copy-item): Add 'db' parameter. Call
'sqlite-register' instead of 'register-path'.
(copy-closure): Remove redundant call to 'references*'. Call
'call-with-database' and pass the database to 'copy-item'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/scripts/system.scm | 59 | ||||
-rw-r--r-- | guix/store/database.scm | 1 |
2 files changed, 33 insertions, 27 deletions
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 0e543d9460..5427f875ec 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -29,7 +29,9 @@ #:use-module (guix ui) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix store) - #:autoload (guix store database) (register-path) + #:autoload (guix base16) (bytevector->base16-string) + #:autoload (guix store database) + (sqlite-register store-database-file call-with-database) #:autoload (guix build store-copy) (copy-store-item) #:use-module (guix describe) #:use-module (guix grafts) @@ -130,12 +132,11 @@ BODY..., and restore them." (store-lift topologically-sorted)) -(define* (copy-item item references target +(define* (copy-item item info target db #:key (log-port (current-error-port))) - "Copy ITEM to the store under root directory TARGET and register it with -REFERENCES as its set of references." - (let ((dest (string-append target item)) - (state (string-append target "/var/guix"))) + "Copy ITEM to the store under root directory TARGET and populate DB with the +given INFO, a <path-info> record." + (let ((dest (string-append target item))) (format log-port "copying '~a'...~%" item) ;; Remove DEST if it exists to make sure that (1) we do not fail badly @@ -151,41 +152,45 @@ REFERENCES as its set of references." (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 - ;; reproducing the user's current settings; see - ;; <http://bugs.gnu.org/18049>. - (unless (register-path item - #:prefix target - #:state-directory state - #:references references) - (leave (G_ "failed to register '~a' under '~a'~%") - item target)))) + (sqlite-register db + #:path item + #:references (path-info-references info) + #:deriver (path-info-deriver info) + #:hash (string-append + "sha256:" + (bytevector->base16-string (path-info-hash info))) + #:nar-size (path-info-nar-size info)))) (define* (copy-closure item target #:key (log-port (current-error-port))) "Copy ITEM and all its dependencies to the store under root directory TARGET, and register them." (mlet* %store-monad ((to-copy (topologically-sorted* (list item))) - (refs (mapm %store-monad references* to-copy)) - (info (mapm %store-monad query-path-info* - (delete-duplicates - (append to-copy (concatenate refs))))) + (info (mapm %store-monad query-path-info* to-copy)) (size -> (reduce + 0 (map path-info-nar-size info)))) (define progress-bar (progress-reporter/bar (length to-copy) (format #f (G_ "copying to '~a'...") target))) + (define state + (string-append target "/var/guix")) + (check-available-space size target) - (call-with-progress-reporter progress-bar - (lambda (report) - (let ((void (%make-void-port "w"))) - (for-each (lambda (item refs) - (copy-item item refs target #:log-port void) - (report)) - to-copy refs)))) + ;; Explicitly use "TARGET/var/guix" as the state directory to avoid + ;; reproducing the user's current settings; see + ;; <http://bugs.gnu.org/18049>. + (call-with-database (store-database-file #:prefix target + #:state-directory state) + (lambda (db) + (call-with-progress-reporter progress-bar + (lambda (report) + (let ((void (%make-void-port "w"))) + (for-each (lambda (item info) + (copy-item item info target db #:log-port void) + (report)) + to-copy info)))))) (return *unspecified*))) diff --git a/guix/store/database.scm b/guix/store/database.scm index c0010b72b9..9d5bc531bb 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -39,6 +39,7 @@ #:export (sql-schema %default-database-file store-database-file + call-with-database with-database path-id sqlite-register |