summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-06 19:05:25 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-06 19:05:25 +0200
commitc63d94035f7cff02d885f9deaaf4011d52a1151d (patch)
treedd5d61aac93022245d770c95b8567abc37794295
parentaa0f8409db9abb4d8d04127b1072f12a64b5f7ee (diff)
downloadpatches-c63d94035f7cff02d885f9deaaf4011d52a1151d.tar
patches-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.
-rw-r--r--.dir-locals.el2
-rw-r--r--guix/store.scm21
-rw-r--r--tests/store.scm54
3 files changed, 73 insertions, 4 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 7ac7e13ff1..cbcb120edf 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -46,7 +46,7 @@
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
- (eval . (put 'with-derivation-substitute 'scheme-indent-function 1))
+ (eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1))
diff --git a/guix/store.scm b/guix/store.scm
index 8905a5a558..933708defc 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -91,6 +91,7 @@
requisites
referrers
optimize-store
+ verify-store
topologically-sorted
valid-derivers
query-derivation-outputs
@@ -174,7 +175,8 @@
(query-valid-paths 31)
(query-substitutable-paths 32)
(query-valid-derivers 33)
- (optimize-store 34))
+ (optimize-store 34)
+ (verify-store 35))
(define-enumerate-type hash-algo
;; hash.hh
@@ -497,8 +499,8 @@ encoding conversion errors."
;; Client-provided substitute URLs. For
;; unprivileged clients, these are considered
- ;; "untrusted"; for root, they override the
- ;; daemon's settings.
+ ;; "untrusted"; for "trusted" users, they override
+ ;; the daemon's settings.
(substitute-urls %default-substitute-urls))
;; Must be called after `open-connection'.
@@ -769,6 +771,19 @@ Return #t on success."
;; Note: the daemon in Guix <= 0.8.2 does not implement this RPC.
boolean)
+(define verify-store
+ (let ((verify (operation (verify-store (boolean check-contents?)
+ (boolean repair?))
+ "Verify the store."
+ boolean)))
+ (lambda* (store #:key check-contents? repair?)
+ "Verify the integrity of the store and return false if errors remain,
+and true otherwise. When REPAIR? is true, repair any missing or altered store
+items by substituting them (this typically requires root privileges because it
+is not an atomic operation.) When CHECK-CONTENTS? is true, check the contents
+of store items; this can take a lot of time."
+ (not (verify store check-contents? repair?)))))
+
(define (run-gc server action to-delete min-freed)
"Perform the garbage-collector operation ACTION, one of the
`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is
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))