From: "Ludovic Courtès" <ludo@gnu.org>
To: 31755@debbugs.gnu.org
Subject: [bug#31755] [PATCH 01/19] database: 'with-database' can now initialize new databases.
Date: Fri, 8 Jun 2018 11:34:33 +0200 [thread overview]
Message-ID: <20180608093451.27760-1-ludo@gnu.org> (raw)
In-Reply-To: <20180608093042.23594-1-ludo@gnu.org>
* 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.
---
Makefile.am | 1 +
guix/self.scm | 4 +-
guix/store/database.scm | 50 ++++++++++++++++++++++---
{nix/libstore => guix/store}/schema.sql | 0
nix/local.mk | 2 +-
tests/store-database.scm | 23 ++++++++++++
6 files changed, 73 insertions(+), 7 deletions(-)
rename {nix/libstore => guix/store}/schema.sql (100%)
diff --git a/Makefile.am b/Makefile.am
index 474575c9f..102f5a2e7 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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
diff --git a/guix/self.scm b/guix/self.scm
index 3acfac6f8..f8b8642bf 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -259,7 +259,9 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'."
;; 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))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 3623c0e7a..e81ab3dc9 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -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.
diff --git a/nix/libstore/schema.sql b/guix/store/schema.sql
similarity index 100%
rename from nix/libstore/schema.sql
rename to guix/store/schema.sql
diff --git a/nix/local.mk b/nix/local.mk
index 39717711f..b4c6ba61a 100644
--- a/nix/local.mk
+++ b/nix/local.mk
@@ -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 \"$@\" \
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 1348a75c2..794736859 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -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")
--
2.17.1
next prev parent reply other threads:[~2018-06-08 9:36 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-06-08 9:30 [bug#31755] [PATCH 00/19] Use (guix store database) instead of 'guix-register' Ludovic Courtès
2018-06-08 9:34 ` Ludovic Courtès [this message]
2018-06-08 9:34 ` [bug#31755] [PATCH 02/19] database: Fail registration when encountering unregistered references Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 03/19] store-copy: 'read-reference-graph' returns a list of records Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 04/19] build: Require Guile-SQLite3 Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 05/19] database: Provide a way to specify the schema location Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 06/19] database: 'register-path' creates the database directory if needed Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 07/19] deduplicate: Fix a couple of thinkos Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 08/19] database: Remove extra SQL parameter in 'update-or-insert' Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 09/19] database: Add #:reset-timestamps? to 'register-path' Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 10/19] database: Replace existing entries in Refs Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 11/19] database: 'reset-timestamps' sets file permissions as well Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 12/19] vm: 'expression->derivation-in-linux-vm' code can now use dlopen Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 13/19] install: Use (guix store database) instead of 'guix-register' Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 14/19] database: 'sqlite-register' takes a database, not a file name Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 15/19] database: Add 'register-items' Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 16/19] install: Use 'reset-timestamps' from (guix store database) Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 17/19] database: Allow for deterministic database construction Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 18/19] store: Remove 'register-path' Ludovic Courtès
2018-06-08 9:34 ` [bug#31755] [PATCH 19/19] Remove 'guix-register' and its traces Ludovic Courtès
2018-06-14 9:17 ` bug#31755: [PATCH 00/19] Use (guix store database) instead of 'guix-register' Ludovic Courtès
[not found] ` <handler.31755.D31755.15289678758292.notifdone@debbugs.gnu.org>
2018-06-14 9:30 ` [bug#31755] closed (Re: [bug#31755] [PATCH 00/19] Use (guix store database) instead of 'guix-register') Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20180608093451.27760-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=31755@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).