diff options
Diffstat (limited to 'guix/store/database.scm')
-rw-r--r-- | guix/store/database.scm | 44 |
1 files changed, 30 insertions, 14 deletions
diff --git a/guix/store/database.scm b/guix/store/database.scm index 0879a95d0b..341276bc30 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -23,6 +23,7 @@ #:use-module (guix serialization) #:use-module (guix store deduplication) #:use-module (guix base16) + #:use-module (guix progress) #:use-module (guix build syscalls) #:use-module ((guix build utils) #:select (mkdir-p executable-file?)) @@ -234,7 +235,8 @@ be used internally by the daemon's build hook." #:prefix prefix #:state-directory state-directory #:deduplicate? deduplicate? #:reset-timestamps? reset-timestamps? - #:schema schema)) + #:schema schema + #:log-port (%make-void-port "w"))) (define %epoch ;; When it all began. @@ -245,12 +247,14 @@ be used internally by the daemon's build hook." (deduplicate? #t) (reset-timestamps? #t) registration-time - (schema (sql-schema))) + (schema (sql-schema)) + (log-port (current-error-port))) "Register all of ITEMS, a list of <store-info> records as returned by 'read-reference-graph', in the database under PREFIX/STATE-DIRECTORY. ITEMS must be in topological order (with leaves first.) If the database is initially empty, apply SCHEMA to initialize it. REGISTRATION-TIME must be the -registration time to be recorded in the database; #f means \"now\"." +registration time to be recorded in the database; #f means \"now\". +Write a progress report to LOG-PORT." ;; Priority for options: first what is given, then environment variables, ;; then defaults. %state-directory, %store-directory, and @@ -286,20 +290,32 @@ registration time to be recorded in the database; #f means \"now\"." (define real-file-name (string-append store-dir "/" (basename (store-info-item item)))) - (let-values (((hash nar-size) (nar-sha256 real-file-name))) + ;; When TO-REGISTER is already registered, skip it. This makes a + ;; significant differences when 'register-closures' is called + ;; consecutively for overlapping closures such as 'system' and 'bootcfg'. + (unless (path-id db to-register) (when reset-timestamps? (reset-timestamps real-file-name)) - (sqlite-register db #:path to-register - #:references (store-info-references item) - #:deriver (store-info-deriver item) - #:hash (string-append "sha256:" - (bytevector->base16-string hash)) - #:nar-size nar-size - #:time registration-time) - (when deduplicate? - (deduplicate real-file-name hash #:store store-dir)))) + (let-values (((hash nar-size) (nar-sha256 real-file-name))) + (sqlite-register db #:path to-register + #:references (store-info-references item) + #:deriver (store-info-deriver item) + #:hash (string-append "sha256:" + (bytevector->base16-string hash)) + #:nar-size nar-size + #:time registration-time) + (when deduplicate? + (deduplicate real-file-name hash #:store store-dir))))) (mkdir-p db-dir) (parameterize ((sql-schema schema)) (with-database (string-append db-dir "/db.sqlite") db - (for-each (cut register db <>) items)))) + (let* ((prefix (format #f "registering ~a items" (length items))) + (progress (progress-reporter/bar (length items) + prefix log-port))) + (call-with-progress-reporter progress + (lambda (report) + (for-each (lambda (item) + (register db item) + (report)) + items))))))) |