[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/09: database: 'register-items' takes an open database.
From: |
guix-commits |
Subject: |
03/09: database: 'register-items' takes an open database. |
Date: |
Thu, 18 Jun 2020 08:49:36 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 97a46055ca9f72986740c26a5406b5138176ca61
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 18 11:51:44 2020 +0200
database: 'register-items' takes an open database.
* guix/store/database.scm (store-database-directory)
(store-database-file): New procedures.
(call-with-database): Add call to 'mkdir-p'.
(register-items): Add 'db' parameter and remove #:state-directory and
#:schema.
(register-path): Use 'store-database-file' and 'with-database', and
parameterize SQL-SCHEMA.
* gnu/build/image.scm (register-closure): Likewise.
* gnu/build/vm.scm (register-closure): Likewise.
* guix/scripts/pack.scm (store-database)[build]: Likewise.
---
gnu/build/image.scm | 13 ++++---
gnu/build/vm.scm | 13 ++++---
guix/scripts/pack.scm | 15 +++++---
guix/store/database.scm | 98 +++++++++++++++++++++++++++----------------------
4 files changed, 77 insertions(+), 62 deletions(-)
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 893b846..e8df586 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -137,12 +137,13 @@ produced by #:references-graphs.. As a side effect, if
RESET-TIMESTAMPS? is
true, reset timestamps on store files and, if DEDUPLICATE? is true,
deduplicates files common to CLOSURE and the rest of PREFIX."
(let ((items (call-with-input-file closure read-reference-graph)))
- (register-items items
- #:prefix prefix
- #:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
- #:registration-time %epoch
- #:schema schema)))
+ (parameterize ((sql-schema schema))
+ (with-database (store-database-file #:prefix prefix) db
+ (register-items db items
+ #:prefix prefix
+ #:deduplicate? deduplicate?
+ #:reset-timestamps? reset-timestamps?
+ #:registration-time %epoch)))))
(define* (initialize-efi-partition root
#:key
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 0f0ceae..287d099 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -223,12 +223,13 @@ produced by #:references-graphs.. As a side effect, if
RESET-TIMESTAMPS? is
true, reset timestamps on store files and, if DEDUPLICATE? is true,
deduplicates files common to CLOSURE and the rest of PREFIX."
(let ((items (call-with-input-file closure read-reference-graph)))
- (register-items items
- #:prefix prefix
- #:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
- #:registration-time %epoch
- #:schema schema)))
+ (parameterize ((sql-schema schema))
+ (with-database (store-database-file #:prefix prefix) db
+ (register-items db items
+ #:prefix prefix
+ #:deduplicate? deduplicate?
+ #:reset-timestamps? reset-timestamps?
+ #:registration-time %epoch)))))
;;;
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 55fb3e8..e0f9cc1 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -146,13 +146,16 @@ dependencies are registered."
(define (read-closure closure)
(call-with-input-file closure read-reference-graph))
+ (define db-file
+ (store-database-file #:state-directory #$output))
+
+ (sql-schema #$schema)
(let ((items (append-map read-closure '#$labels)))
- (register-items items
- #:state-directory #$output
- #:deduplicate? #f
- #:reset-timestamps? #f
- #:registration-time %epoch
- #:schema #$schema))))))
+ (with-database db-file db
+ (register-items db items
+ #:deduplicate? #f
+ #:reset-timestamps? #f
+ #:registration-time %epoch)))))))
(computed-file "store-database" build
#:options `(#:references-graphs ,(zip labels items))))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index ad9ca68..a38e4d7 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -37,6 +37,7 @@
#:use-module (system foreign)
#:export (sql-schema
%default-database-file
+ store-database-file
with-database
path-id
sqlite-register
@@ -65,6 +66,28 @@
(unless (zero? ret)
((@@ (sqlite3) sqlite-error) db "sqlite-exec" ret))))))
+(define* (store-database-directory #:key prefix state-directory)
+ "Return the store database directory, taking PREFIX and STATE-DIRECTORY into
+account when provided."
+ ;; Priority for options: first what is given, then environment variables,
+ ;; then defaults. %state-directory, %store-directory, and
+ ;; %store-database-directory already handle the "environment variables /
+ ;; defaults" question, so we only need to choose between what is given and
+ ;; those.
+ (cond (state-directory
+ (string-append state-directory "/db"))
+ (prefix
+ (string-append prefix %localstatedir "/guix/db"))
+ (else
+ %store-database-directory)))
+
+(define* (store-database-file #:key prefix state-directory)
+ "Return the store database file name, taking PREFIX and STATE-DIRECTORY into
+account when provided."
+ (string-append (store-database-directory #:prefix prefix
+ #:state-directory state-directory)
+ "/db.sqlite"))
+
(define (initialize-database db)
"Initializing DB, an empty database, by creating all the tables and indexes
as specified by SQL-SCHEMA."
@@ -77,7 +100,10 @@ as specified by SQL-SCHEMA."
(define (call-with-database file proc)
"Pass PROC a database record corresponding to FILE. If FILE doesn't exist,
create it and initialize it as a new database."
- (let ((new? (not (file-exists? file)))
+ (let ((new? (and (not (file-exists? file))
+ (begin
+ (mkdir-p (dirname file))
+ #t)))
(db (sqlite-open file)))
;; Turn DB in "write-ahead log" mode, which should avoid SQLITE_LOCKED
;; errors when we have several readers: <https://www.sqlite.org/wal.html>.
@@ -361,45 +387,32 @@ Return #t on success.
Use with care as it directly modifies the store! This is primarily meant to
be used internally by the daemon's build hook."
- (register-items (list (store-info path deriver references))
- #:prefix prefix #:state-directory state-directory
- #:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
- #:schema schema
- #:log-port (%make-void-port "w")))
+ (define db-file
+ (store-database-file #:prefix prefix
+ #:state-directory state-directory))
+
+ (parameterize ((sql-schema schema))
+ (with-database db-file db
+ (register-items db (list (store-info path deriver references))
+ #:prefix prefix
+ #:deduplicate? deduplicate?
+ #:reset-timestamps? reset-timestamps?
+ #:log-port (%make-void-port "w")))))
(define %epoch
;; When it all began.
(make-time time-utc 0 1))
-(define* (register-items items
- #:key prefix state-directory
+(define* (register-items db items
+ #:key prefix
(deduplicate? #t)
(reset-timestamps? #t)
registration-time
- (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\".
-Write a progress report to LOG-PORT."
-
- ;; Priority for options: first what is given, then environment variables,
- ;; then defaults. %state-directory, %store-directory, and
- ;; %store-database-directory already handle the "environment variables /
- ;; defaults" question, so we only need to choose between what is given and
- ;; those.
-
- (define db-dir
- (cond (state-directory
- (string-append state-directory "/db"))
- (prefix
- (string-append prefix %localstatedir "/guix/db"))
- (else
- %store-database-directory)))
-
+'read-reference-graph', in DB. ITEMS must be in topological order (with
+leaves first.) REGISTRATION-TIME must be the registration time to be recorded
+in the database; #f means \"now\". Write a progress report to LOG-PORT."
(define store-dir
(if prefix
(string-append prefix %storedir)
@@ -438,17 +451,14 @@ Write a progress report to LOG-PORT."
(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
- (call-with-retrying-transaction db
- (lambda ()
- (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)))))))))
+ (call-with-retrying-transaction db
+ (lambda ()
+ (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)))))))
- branch master updated (e418c3d -> 69288a8), guix-commits, 2020/06/18
- 01/09: repl: Fix typo that would lead ~/.guile to be used when running scripts., guix-commits, 2020/06/18
- 03/09: database: 'register-items' takes an open database.,
guix-commits <=
- 04/09: nar: Avoid opening the database an additional time., guix-commits, 2020/06/18
- 05/09: nar: Use (guix i18n)., guix-commits, 2020/06/18
- 06/09: profiles: Reindent 'linux-module-database'., guix-commits, 2020/06/18
- 08/09: doc: Delete description of a nonexistent option., guix-commits, 2020/06/18
- 02/09: build-system/gnu: Fix 'install' phase of 'gnu-dist'., guix-commits, 2020/06/18
- 07/09: profiles: 'linux-module-database' hooks gracefully handles module-less kernels., guix-commits, 2020/06/18
- 09/09: gnu: go-ipfs: Update to 0.5.1., guix-commits, 2020/06/18