database: Fail registration when encountering unregistered references.
* guix/store/database.scm (add-reference-sql): Remove nested SELECT. (add-references): Expect REFERENCES to be a list of ids. (sqlite-register): Call 'path-id' for each of REFERENCES and pass it to 'add-references'. * tests/store-database.scm ("register-path with unregistered references"): New test.
This commit is contained in:
parent
3931c76154
commit
f8f9f7cabc
@ -27,6 +27,7 @@
|
|||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
@ -139,13 +140,11 @@ of course. Returns the row id of the row that was modified or inserted."
|
|||||||
(last-insert-row-id db)))))
|
(last-insert-row-id db)))))
|
||||||
|
|
||||||
(define add-reference-sql
|
(define add-reference-sql
|
||||||
"INSERT OR IGNORE INTO Refs (referrer, reference) SELECT :referrer, id
|
"INSERT INTO Refs (referrer, reference) VALUES (:referrer, :reference);")
|
||||||
FROM ValidPaths WHERE path = :reference")
|
|
||||||
|
|
||||||
(define (add-references db referrer references)
|
(define (add-references db referrer references)
|
||||||
"REFERRER is the id of the referring store item, REFERENCES is a list
|
"REFERRER is the id of the referring store item, REFERENCES is a list
|
||||||
containing store items being referred to. Note that all of the store items in
|
ids of items referred to."
|
||||||
REFERENCES must already be registered."
|
|
||||||
(let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t)))
|
(let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t)))
|
||||||
(for-each (lambda (reference)
|
(for-each (lambda (reference)
|
||||||
(sqlite-reset stmt)
|
(sqlite-reset stmt)
|
||||||
@ -164,15 +163,20 @@ path of some store item, REFERENCES is a list of string paths which the store
|
|||||||
item PATH refers to (they need to be already registered!), DERIVER is a string
|
item PATH refers to (they need to be already registered!), DERIVER is a string
|
||||||
path of the derivation that created the store item PATH, HASH is the
|
path of the derivation that created the store item PATH, HASH is the
|
||||||
base16-encoded sha256 hash of the store item denoted by PATH (prefixed with
|
base16-encoded sha256 hash of the store item denoted by PATH (prefixed with
|
||||||
\"sha256:\") after being converted to nar form, and nar-size is the size in
|
\"sha256:\") after being converted to nar form, and NAR-SIZE is the size in
|
||||||
bytes of the store item denoted by PATH after being converted to nar form."
|
bytes of the store item denoted by PATH after being converted to nar form.
|
||||||
|
|
||||||
|
Every store item in REFERENCES must already be registered."
|
||||||
(with-database db-file db
|
(with-database db-file db
|
||||||
(let ((id (update-or-insert db #:path path
|
(let ((id (update-or-insert db #:path path
|
||||||
#:deriver deriver
|
#:deriver deriver
|
||||||
#:hash hash
|
#:hash hash
|
||||||
#:nar-size nar-size
|
#:nar-size nar-size
|
||||||
#:time (time-second (current-time time-utc)))))
|
#:time (time-second (current-time time-utc)))))
|
||||||
(add-references db id references))))
|
;; Call 'path-id' on each of REFERENCES. This ensures we get a
|
||||||
|
;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
|
||||||
|
(add-references db id
|
||||||
|
(map (cut path-id db <>) references)))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -74,4 +74,24 @@
|
|||||||
(list (path-id db "/gnu/foo")
|
(list (path-id db "/gnu/foo")
|
||||||
(path-id db "/gnu/bar")))))))
|
(path-id db "/gnu/bar")))))))
|
||||||
|
|
||||||
|
(test-assert "register-path with unregistered references"
|
||||||
|
;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error
|
||||||
|
;; when we try to add references that are not registered yet. Better safe
|
||||||
|
;; than sorry.
|
||||||
|
(call-with-temporary-output-file
|
||||||
|
(lambda (db-file port)
|
||||||
|
(delete-file db-file)
|
||||||
|
(catch 'sqlite-error
|
||||||
|
(lambda ()
|
||||||
|
(sqlite-register #:db-file db-file
|
||||||
|
#:path "/gnu/foo"
|
||||||
|
#:references '("/gnu/bar")
|
||||||
|
#:deriver "/gnu/foo.drv"
|
||||||
|
#:hash (string-append "sha256:" (make-string 64 #\e))
|
||||||
|
#:nar-size 1234)
|
||||||
|
#f)
|
||||||
|
(lambda args
|
||||||
|
(pk 'welcome-exception! args)
|
||||||
|
#t)))))
|
||||||
|
|
||||||
(test-end "store-database")
|
(test-end "store-database")
|
||||||
|
Loading…
Reference in New Issue
Block a user