diff options
| -rw-r--r-- | .dir-locals.el | 2 | ||||
| -rw-r--r-- | guix/store.scm | 21 | ||||
| -rw-r--r-- | tests/store.scm | 54 |
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)) |