+(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-assert "build-things, check mode"
+ (with-store store
+ (call-with-temporary-output-file
+ (lambda (entropy entropy-port)
+ (write (random-text) entropy-port)
+ (force-output entropy-port)
+ (let* ((drv (build-expression->derivation
+ store "non-deterministic"
+ `(begin
+ (use-modules (rnrs io ports))
+ (let ((out (assoc-ref %outputs "out")))
+ (call-with-output-file out
+ (lambda (port)
+ ;; Rely on the fact that tests do not use the
+ ;; chroot, and thus ENTROPY is readable.
+ (display (call-with-input-file ,entropy
+ get-string-all)
+ port)))
+ #t))
+ #:guile-for-build
+ (package-derivation store %bootstrap-guile (%current-system))))
+ (file (derivation->output-path drv)))
+ (and (build-things store (list (derivation-file-name drv)))
+ (begin
+ (write (random-text) entropy-port)
+ (force-output entropy-port)
+ (guard (c ((store-protocol-error? c)
+ (pk 'determinism-exception c)
+ (and (not (zero? (store-protocol-error-status c)))
+ (string-contains (store-protocol-error-message c)
+ "deterministic"))))
+ ;; This one will produce a different result. Since we're in
+ ;; 'check' mode, this must fail.
+ (build-things store (list (derivation-file-name drv))
+ (build-mode check))
+ #f))))))))
+
+(test-assert "build-succeeded trace in check mode"
+ (string-contains
+ (call-with-output-string
+ (lambda (port)
+ (let ((d (build-expression->derivation
+ %store "foo" '(mkdir (assoc-ref %outputs "out"))
+ #:guile-for-build
+ (package-derivation %store %bootstrap-guile))))
+ (build-derivations %store (list d))
+ (parameterize ((current-build-output-port port))
+ (build-derivations %store (list d) (build-mode check))))))
+ "@ build-succeeded"))
+
+(test-assert "build multiple times"
+ (with-store store
+ ;; Ask to build twice.
+ (set-build-options store #:rounds 2 #:use-substitutes? #f)
+
+ (call-with-temporary-output-file
+ (lambda (entropy entropy-port)
+ (write (random-text) entropy-port)
+ (force-output entropy-port)
+ (let* ((drv (build-expression->derivation
+ store "non-deterministic"
+ `(begin
+ (use-modules (rnrs io ports))
+ (let ((out (assoc-ref %outputs "out")))
+ (call-with-output-file out
+ (lambda (port)
+ ;; Rely on the fact that tests do not use the
+ ;; chroot, and thus ENTROPY is accessible.
+ (display (call-with-input-file ,entropy
+ get-string-all)
+ port)
+ (call-with-output-file ,entropy
+ (lambda (port)
+ (write 'foobar port)))))
+ #t))
+ #:guile-for-build
+ (package-derivation store %bootstrap-guile (%current-system))))
+ (file (derivation->output-path drv)))
+ (guard (c ((store-protocol-error? c)
+ (pk 'multiple-build c)
+ (and (not (zero? (store-protocol-error-status c)))
+ (string-contains (store-protocol-error-message c)
+ "deterministic"))))
+ ;; This one will produce a different result on the second run.
+ (current-build-output-port (current-error-port))
+ (build-things store (list (derivation-file-name drv)))
+ #f))))))