me
/
guix
Archived
1
0
Fork 0

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'.
master
Ludovic Courtès 2020-12-11 12:36:52 +01:00
parent 0682cc5936
commit 1574bd82bb
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 34 additions and 27 deletions

View File

@ -121,6 +121,7 @@
(eval . (put 'let-system 'scheme-indent-function 1))
(eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-database 'scheme-indent-function 1))
(eval . (put 'call-with-transaction 'scheme-indent-function 1))
(eval . (put 'with-statement 'scheme-indent-function 3))
(eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1))

View File

@ -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)
;; 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 refs)
(copy-item item refs target #:log-port void)
(for-each (lambda (item info)
(copy-item item info target db #:log-port void)
(report))
to-copy refs))))
to-copy info))))))
(return *unspecified*)))

View File

@ -39,6 +39,7 @@
#:export (sql-schema
%default-database-file
store-database-file
call-with-database
with-database
path-id
sqlite-register