ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

database: 'register-items' takes an open database.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2020-06-18 11:51:44 +02:00
parent f9a0fc9dbb
commit 97a46055ca
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 77 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gnu/build/image.scm
View file

@ -137,12 +137,13 @@ (define* (register-closure prefix closure
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

13
gnu/build/vm.scm
View file

@ -223,12 +223,13 @@ (define* (register-closure prefix closure
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)))))
;;;

15
guix/scripts/pack.scm
View file

@ -146,13 +146,16 @@ (define build
(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))))

98
guix/store/database.scm
View file

@ -37,6 +37,7 @@ (define-module (guix store database)
#:use-module (system foreign)
#:export (sql-schema
%default-database-file
store-database-file
with-database
path-id
sqlite-register
@ -65,6 +66,28 @@ (define sqlite-exec
(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 @@ (define 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 @@ (define* (register-path path
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 @@ (define real-file-name
(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)))))))