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.
master
Ludovic Courtès 2018-06-04 18:33:19 +02:00
parent 3931c76154
commit f8f9f7cabc
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 7 deletions

View File

@ -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)))))
;;; ;;;

View File

@ -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")