me
/
guix
Archived
1
0
Fork 0

database: 'with-database' can now initialize new databases.

* nix/libstore/schema.sql: Rename to...
* guix/store/schema.sql: ... this.
* Makefile.am (nobase_dist_guilemodule_DATA): Add it.
* nix/local.mk (%D%/libstore/schema.sql.hh): Adjust accordingly.
* guix/store/database.scm (sql-schema): New variable.
(sqlite-exec, initialize-database, call-with-database): New procedures.
(with-database): Rewrite in terms of 'call-with-database'.
* tests/store-database.scm ("new database"): New test.
* guix/self.scm (compiled-guix)[*core-modules*]: Add 'schema.sql' to
 #:extra-files.
master
Ludovic Courtès 2018-06-04 15:40:09 +02:00
parent 03439df66f
commit 3931c76154
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
6 changed files with 73 additions and 7 deletions

View File

@ -300,6 +300,7 @@ EXAMPLES = \
GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go $(dist_noinst_DATA:%.scm=%.go)
nobase_dist_guilemodule_DATA = \
guix/store/schema.sql \
$(MODULES) $(MODULES_NOT_COMPILED) $(AUX_FILES) $(EXAMPLES) \
$(MISC_DISTRO_FILES)
nobase_nodist_guilemodule_DATA = guix/config.scm

View File

@ -482,7 +482,9 @@ the modules, and DEPENDENCIES, a list of packages depended on. COMMAND is the
;; but we don't need to compile it; not compiling it allows
;; us to avoid an extra dependency on guile-gdbm-ffi.
#:extra-files
`(("guix/man-db.scm" ,(local-file "../guix/man-db.scm")))
`(("guix/man-db.scm" ,(local-file "../guix/man-db.scm"))
("guix/store/schema.sql"
,(local-file "../guix/store/schema.sql")))
#:guile-for-build guile-for-build))

View File

@ -24,25 +24,65 @@
#:use-module (guix store deduplication)
#:use-module (guix base16)
#:use-module (guix build syscalls)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
#:export (sqlite-register
#:use-module (system foreign)
#:export (sql-schema
with-database
sqlite-register
register-path
reset-timestamps))
;;; Code for working with the store database directly.
(define sql-schema
;; Name of the file containing the SQL scheme or #f.
(make-parameter #f))
(define-syntax-rule (with-database file db exp ...)
"Open DB from FILE and close it when the dynamic extent of EXP... is left."
(let ((db (sqlite-open file)))
(define sqlite-exec
;; XXX: This is was missing from guile-sqlite3 until
;; <https://notabug.org/civodul/guile-sqlite3/commit/b87302f9bcd18a286fed57b2ea521845eb1131d7>.
(let ((exec (pointer->procedure
int
(dynamic-func "sqlite3_exec" (@@ (sqlite3) libsqlite3))
'(* * * * *))))
(lambda (db text)
(let ((ret (exec ((@@ (sqlite3) db-pointer) db)
(string->pointer text)
%null-pointer %null-pointer %null-pointer)))
(unless (zero? ret)
((@@ (sqlite3) sqlite-error) db "sqlite-exec" ret))))))
(define (initialize-database db)
"Initializing DB, an empty database, by creating all the tables and indexes
as specified by SQL-SCHEMA."
(define schema
(or (sql-schema)
(search-path %load-path "guix/store/schema.sql")))
(sqlite-exec db (call-with-input-file schema get-string-all)))
(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)))
(db (sqlite-open file)))
(dynamic-wind noop
(lambda ()
exp ...)
(when new?
(initialize-database db))
(proc db))
(lambda ()
(sqlite-close db)))))
(define-syntax-rule (with-database file db exp ...)
"Open DB from FILE and close it when the dynamic extent of EXP... is left.
If FILE doesn't exist, create it and initialize it as a new database."
(call-with-database file (lambda (db) exp ...)))
(define (last-insert-row-id db)
;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'.
;; Work around that.

View File

@ -163,7 +163,7 @@ noinst_HEADERS = \
$(libformat_headers) $(libutil_headers) $(libstore_headers) \
$(guix_daemon_headers)
%D%/libstore/schema.sql.hh: %D%/libstore/schema.sql
%D%/libstore/schema.sql.hh: guix/store/schema.sql
$(AM_V_GEN)$(GUILE) --no-auto-compile -c \
"(use-modules (rnrs io ports)) \
(call-with-output-file \"$@\" \

View File

@ -20,6 +20,7 @@
#:use-module (guix tests)
#:use-module ((guix store) #:hide (register-path))
#:use-module (guix store database)
#:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64))
@ -51,4 +52,26 @@
(null? (valid-derivers %store file))
(null? (referrers %store file))))))
(test-equal "new database"
(list 1 2)
(call-with-temporary-output-file
(lambda (db-file port)
(delete-file db-file)
(sqlite-register #:db-file db-file
#:path "/gnu/foo"
#:references '()
#:deriver "/gnu/foo.drv"
#:hash (string-append "sha256:" (make-string 64 #\e))
#:nar-size 1234)
(sqlite-register #:db-file db-file
#:path "/gnu/bar"
#:references '("/gnu/foo")
#:deriver "/gnu/bar.drv"
#:hash (string-append "sha256:" (make-string 64 #\a))
#:nar-size 4321)
(let ((path-id (@@ (guix store database) path-id)))
(with-database db-file db
(list (path-id db "/gnu/foo")
(path-id db "/gnu/bar")))))))
(test-end "store-database")