diff options
| -rw-r--r-- | guix/store/database.scm | 35 | ||||
| -rw-r--r-- | tests/pack.scm | 2 | ||||
| -rw-r--r-- | tests/store-database.scm | 53 |
3 files changed, 46 insertions, 44 deletions
diff --git a/guix/store/database.scm b/guix/store/database.scm index dea690ec76..58d3871e85 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -40,8 +40,10 @@ store-database-file call-with-database with-database - path-id - sqlite-register + + valid-path-id + + register-valid-path register-items %epoch reset-timestamps @@ -181,9 +183,9 @@ If FILE doesn't exist, create it and initialize it as a new database. Pass (vector-ref (sqlite-step-and-reset stmt) 0))) -(define* (path-id db path) - "If PATH exists in the 'ValidPaths' table, return its numerical -identifier. Otherwise, return #f." +(define (valid-path-id db path) + "If PATH exists in the 'ValidPaths' table, return its numerical identifier. +Otherwise, return #f." (let ((stmt (sqlite-prepare db " @@ -249,7 +251,7 @@ Every store item in REFERENCES must already be registered." (assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time) (define id - (let ((existing-id (path-id db path))) + (let ((existing-id (valid-path-id db path))) (if existing-id (let ((stmt (sqlite-prepare db @@ -284,7 +286,8 @@ VALUES (:path, :hash, :time, :deriver, :size)" ;; 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))) + (map (cut valid-path-id db <>) references))) + ;;; @@ -361,18 +364,18 @@ typically by adding them as temp-roots." ;; When TO-REGISTER is already registered, skip it. This makes a ;; significant differences when 'register-closures' is called ;; consecutively for overlapping closures such as 'system' and 'bootcfg'. - (unless (path-id db to-register) + (unless (valid-path-id db to-register) (let-values (((hash nar-size) (nar-sha256 real-file-name))) (call-with-retrying-transaction db (lambda () - (sqlite-register db #:path to-register - #:references (store-info-references item) - #:deriver (store-info-deriver item) - #:hash (string-append - "sha256:" - (bytevector->base16-string hash)) - #:nar-size nar-size - #:time registration-time)))))) + (register-valid-path db #:path to-register + #:references (store-info-references item) + #:deriver (store-info-deriver item) + #:hash (string-append + "sha256:" + (bytevector->base16-string hash)) + #:nar-size nar-size + #:time registration-time)))))) (let* ((prefix (format #f "registering ~a items" (length items))) (progress (progress-reporter/bar (length items) diff --git a/tests/pack.scm b/tests/pack.scm index 55445ea1e9..40897a5589 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -209,7 +209,7 @@ (and (every valid-file? '("α" "λ") '("alpha" "lambda")) - (integer? (path-id db #$tree))))))))))) + (integer? (valid-path-id db #$tree))))))))))) (built-derivations (list check)))) (unless store (test-skip 1)) diff --git a/tests/store-database.scm b/tests/store-database.scm index d8f3ce8070..67d464386d 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -87,23 +87,22 @@ (lambda (db-file port) (delete-file db-file) (with-database db-file db - (sqlite-register db - #:path "/gnu/foo" - #:references '() - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size 1234) - (sqlite-register db - #: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))) - (list (path-id db "/gnu/foo") - (path-id db "/gnu/bar"))))))) + (register-valid-path db + #:path "/gnu/foo" + #:references '() + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234) + (register-valid-path db + #:path "/gnu/bar" + #:references '("/gnu/foo") + #:deriver "/gnu/bar.drv" + #:hash (string-append "sha256:" (make-string 64 #\a)) + #:nar-size 4321) + (list (valid-path-id db "/gnu/foo") + (valid-path-id db "/gnu/bar")))))) -(test-assert "sqlite-register with unregistered references" +(test-assert "register-valid-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. @@ -113,17 +112,17 @@ (catch 'sqlite-error (lambda () (with-database db-file db - (sqlite-register db #:path "/gnu/foo" - #:references '("/gnu/bar") - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size 1234)) + (register-valid-path db #: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-equal "sqlite-register with incorrect size" +(test-equal "register-valid-path with incorrect size" 'out-of-range (call-with-temporary-output-file (lambda (db-file port) @@ -131,11 +130,11 @@ (catch #t (lambda () (with-database db-file db - (sqlite-register db #:path "/gnu/foo" - #:references '("/gnu/bar") - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size -1234)) + (register-valid-path db #:path "/gnu/foo" + #:references '("/gnu/bar") + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size -1234)) #f) (lambda (key . _) key))))) |