diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/self.scm | 4 | ||||
| -rw-r--r-- | guix/store/database.scm | 50 | ||||
| -rw-r--r-- | guix/store/schema.sql (renamed from nix/libstore/schema.sql) | 0 | ||||
| -rw-r--r-- | nix/local.mk | 2 | ||||
| -rw-r--r-- | tests/store-database.scm | 23 |
6 files changed, 73 insertions, 7 deletions
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 + ;; <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 index c1b4a689af..c1b4a689af 100644 --- a/nix/libstore/schema.sql +++ b/guix/store/schema.sql 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") |