Browse Source

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.
version-0.8.3
Ludovic Courtès 7 years ago
parent
commit
c63d94035f
  1. 2
      .dir-locals.el
  2. 21
      guix/store.scm
  3. 54
      tests/store.scm

2
.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))

21
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

54
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))

Loading…
Cancel
Save