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.
This commit is contained in:
Ludovic Courtès 2015-06-06 19:05:25 +02:00
parent aa0f8409db
commit c63d94035f
3 changed files with 73 additions and 4 deletions

View file

@ -46,7 +46,7 @@
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1)) (eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-variables '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-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 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1))

View file

@ -91,6 +91,7 @@ (define-module (guix store)
requisites requisites
referrers referrers
optimize-store optimize-store
verify-store
topologically-sorted topologically-sorted
valid-derivers valid-derivers
query-derivation-outputs query-derivation-outputs
@ -174,7 +175,8 @@ (define-enumerate-type operation-id
(query-valid-paths 31) (query-valid-paths 31)
(query-substitutable-paths 32) (query-substitutable-paths 32)
(query-valid-derivers 33) (query-valid-derivers 33)
(optimize-store 34)) (optimize-store 34)
(verify-store 35))
(define-enumerate-type hash-algo (define-enumerate-type hash-algo
;; hash.hh ;; hash.hh
@ -497,8 +499,8 @@ (define* (set-build-options server
;; Client-provided substitute URLs. For ;; Client-provided substitute URLs. For
;; unprivileged clients, these are considered ;; unprivileged clients, these are considered
;; "untrusted"; for root, they override the ;; "untrusted"; for "trusted" users, they override
;; daemon's settings. ;; the daemon's settings.
(substitute-urls %default-substitute-urls)) (substitute-urls %default-substitute-urls))
;; Must be called after `open-connection'. ;; Must be called after `open-connection'.
@ -769,6 +771,19 @@ (define-operation (optimize-store)
;; Note: the daemon in Guix <= 0.8.2 does not implement this RPC. ;; Note: the daemon in Guix <= 0.8.2 does not implement this RPC.
boolean) 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) (define (run-gc server action to-delete min-freed)
"Perform the garbage-collector operation ACTION, one of the "Perform the garbage-collector operation ACTION, one of the
`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is `gc-action' values. When ACTION is `delete-specific', the TO-DELETE is

View file

@ -600,6 +600,60 @@ (define (same? x y)
(null? (valid-derivers %store file)) (null? (valid-derivers %store file))
(null? (referrers %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" (test-equal "store-lower"
"Lowered." "Lowered."
(let* ((add (store-lower text-file)) (let* ((add (store-lower text-file))