diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-06-06 19:05:25 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-06-06 19:05:25 +0200 |
commit | c63d94035f7cff02d885f9deaaf4011d52a1151d (patch) | |
tree | dd5d61aac93022245d770c95b8567abc37794295 /tests/store.scm | |
parent | aa0f8409db9abb4d8d04127b1072f12a64b5f7ee (diff) | |
download | guix-c63d94035f7cff02d885f9deaaf4011d52a1151d.tar guix-c63d94035f7cff02d885f9deaaf4011d52a1151d.tar.gz |
store: Add 'verify-store' RPC.
* guix/store.scm (operation-id): Add 'verify-store'.
(verify-store): New procedure.
(set-build-options): Adjust comment.
* tests/store.scm ("verify-store", "verify-store + check-contents"): New
tests.
Diffstat (limited to 'tests/store.scm')
-rw-r--r-- | tests/store.scm | 54 |
1 files changed, 54 insertions, 0 deletions
diff --git a/tests/store.scm b/tests/store.scm index eeceed45c1..faa924fce9 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -600,6 +600,60 @@ (null? (valid-derivers %store file)) (null? (referrers %store file)))))) +(test-assert "verify-store" + (let* ((text (random-text)) + (file1 (add-text-to-store %store "foo" text)) + (file2 (add-text-to-store %store "bar" (random-text) + (list file1)))) + (and (pk 'verify1 (verify-store %store)) ;hopefully OK ; + (begin + (delete-file file1) + (not (pk 'verify2 (verify-store %store)))) ;bad! ; + (begin + ;; Using 'add-text-to-store' here wouldn't work: It would succeed ; + ;; without actually creating the file. ; + (call-with-output-file file1 + (lambda (port) + (display text port))) + (pk 'verify3 (verify-store %store)))))) ;OK again + +(test-assert "verify-store + check-contents" + ;; XXX: This test is I/O intensive. + (with-store s + (let* ((text (random-text)) + (drv (build-expression->derivation + s "corrupt" + `(let ((out (assoc-ref %outputs "out"))) + (call-with-output-file out + (lambda (port) + (display ,text port))) + #t) + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (file (derivation->output-path drv))) + (with-derivation-substitute drv text + (and (build-derivations s (list drv)) + (verify-store s #:check-contents? #t) ;should be OK + (begin + (chmod file #o644) + (call-with-output-file file + (lambda (port) + (display "corrupt!" port))) + #t) + + ;; Make sure the corruption is detected. We don't test repairing + ;; because only "trusted" users are allowed to do it, but we + ;; don't expose that notion of trusted users that nix-daemon + ;; supports because it seems dubious and redundant with what the + ;; OS provides (in Nix "trusted" users have additional + ;; privileges, such as overriding the set of substitute URLs, but + ;; we instead want to allow anyone to modify them, provided + ;; substitutes are signed by a root-approved key.) + (not (verify-store s #:check-contents? #t)) + + ;; Delete the corrupt item to leave the store in a clean state. + (delete-paths s (list file))))))) + (test-equal "store-lower" "Lowered." (let* ((add (store-lower text-file)) |