From 3931c76154d4f418d5ea9acc5e47bf911d371c24 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Jun 2018 15:40:09 +0200 Subject: 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. --- Makefile.am | 1 + guix/self.scm | 4 +++- guix/store/database.scm | 50 +++++++++++++++++++++++++++++++++++++++++++----- guix/store/schema.sql | 44 ++++++++++++++++++++++++++++++++++++++++++ nix/libstore/schema.sql | 44 ------------------------------------------ nix/local.mk | 2 +- tests/store-database.scm | 23 ++++++++++++++++++++++ 7 files changed, 117 insertions(+), 51 deletions(-) create mode 100644 guix/store/schema.sql delete mode 100644 nix/libstore/schema.sql diff --git a/Makefile.am b/Makefile.am index 7898a3648a..0267e8fe50 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 e71e086cdc..ed3f31cdbc 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -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)) diff --git a/guix/store/database.scm b/guix/store/database.scm index 3623c0e7a0..e81ab3dc99 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 + ;; . + (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/guix/store/schema.sql b/guix/store/schema.sql new file mode 100644 index 0000000000..c1b4a689af --- /dev/null +++ b/guix/store/schema.sql @@ -0,0 +1,44 @@ +create table if not exists ValidPaths ( + id integer primary key autoincrement not null, + path text unique not null, + hash text not null, + registrationTime integer not null, + deriver text, + narSize integer +); + +create table if not exists Refs ( + referrer integer not null, + reference integer not null, + primary key (referrer, reference), + foreign key (referrer) references ValidPaths(id) on delete cascade, + foreign key (reference) references ValidPaths(id) on delete restrict +); + +create index if not exists IndexReferrer on Refs(referrer); +create index if not exists IndexReference on Refs(reference); + +-- Paths can refer to themselves, causing a tuple (N, N) in the Refs +-- table. This causes a deletion of the corresponding row in +-- ValidPaths to cause a foreign key constraint violation (due to `on +-- delete restrict' on the `reference' column). Therefore, explicitly +-- get rid of self-references. +create trigger if not exists DeleteSelfRefs before delete on ValidPaths + begin + delete from Refs where referrer = old.id and reference = old.id; + end; + +create table if not exists DerivationOutputs ( + drv integer not null, + id text not null, -- symbolic output id, usually "out" + path text not null, + primary key (drv, id), + foreign key (drv) references ValidPaths(id) on delete cascade +); + +create index if not exists IndexDerivationOutputs on DerivationOutputs(path); + +create table if not exists FailedPaths ( + path text primary key not null, + time integer not null +); diff --git a/nix/libstore/schema.sql b/nix/libstore/schema.sql deleted file mode 100644 index c1b4a689af..0000000000 --- a/nix/libstore/schema.sql +++ /dev/null @@ -1,44 +0,0 @@ -create table if not exists ValidPaths ( - id integer primary key autoincrement not null, - path text unique not null, - hash text not null, - registrationTime integer not null, - deriver text, - narSize integer -); - -create table if not exists Refs ( - referrer integer not null, - reference integer not null, - primary key (referrer, reference), - foreign key (referrer) references ValidPaths(id) on delete cascade, - foreign key (reference) references ValidPaths(id) on delete restrict -); - -create index if not exists IndexReferrer on Refs(referrer); -create index if not exists IndexReference on Refs(reference); - --- Paths can refer to themselves, causing a tuple (N, N) in the Refs --- table. This causes a deletion of the corresponding row in --- ValidPaths to cause a foreign key constraint violation (due to `on --- delete restrict' on the `reference' column). Therefore, explicitly --- get rid of self-references. -create trigger if not exists DeleteSelfRefs before delete on ValidPaths - begin - delete from Refs where referrer = old.id and reference = old.id; - end; - -create table if not exists DerivationOutputs ( - drv integer not null, - id text not null, -- symbolic output id, usually "out" - path text not null, - primary key (drv, id), - foreign key (drv) references ValidPaths(id) on delete cascade -); - -create index if not exists IndexDerivationOutputs on DerivationOutputs(path); - -create table if not exists FailedPaths ( - path text primary key not null, - time integer not null -); diff --git a/nix/local.mk b/nix/local.mk index 39717711f8..b4c6ba61a4 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 1348a75c26..7947368595 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") -- cgit 1.4.1