(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))
requisites
referrers
optimize-store
+ verify-store
topologically-sorted
valid-derivers
query-derivation-outputs
(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
;; 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'.
;; 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
(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))