tests: Make sure the daemon reports substitute hash mismatches.

* tests/store.scm ("substitute, corrupt output hash"): New test.
This commit is contained in:
Ludovic Courtès 2014-03-30 16:01:58 +02:00
parent cdea30e061
commit 491e6de7d6

View file

@ -374,6 +374,64 @@ (define (same? x y)
(build-derivations s (list d))
(equal? c (call-with-input-file o get-string-all)))))
(test-assert "substitute, corrupt output hash"
;; Tweak the substituter into installing a substitute whose hash doesn't
;; match the one announced in the narinfo. The daemon must notice this and
;; raise an error.
(let* ((s (open-connection))
(c "hello, world") ; contents of the output
(d (build-expression->derivation
s "corrupt-substitute"
`(mkdir %output)
#:guile-for-build
(package-derivation s %bootstrap-guile (%current-system))))
(o (derivation->output-path d))
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
(compose uri-path string->uri))))
;; Create fake substituter data, to be read by `substitute-binary'.
(call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix))))
(call-with-output-file (string-append dir "/example.out")
(lambda (p)
(display "The contents here do not match C." p)))
(call-with-output-file (string-append dir "/example.nar")
(lambda (p)
(write-file (string-append dir "/example.out") p)))
(call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo")
(lambda (p)
(format p "StorePath: ~a
URL: ~a
Compression: none
NarSize: 1234
NarHash: sha256:~a
References:
System: ~a
Deriver: ~a~%"
o ; StorePath
"example.nar" ; relative URL
(bytevector->nix-base32-string
(sha256 (string->utf8 c)))
(%current-system) ; System
(basename
(derivation-file-name d))))) ; Deriver
;; Make sure we use `substitute-binary'.
(set-build-options s
#:use-substitutes? #t
#:fallback? #f)
(and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c)
;; XXX: the daemon writes "hash mismatch in downloaded
;; path", but the actual error returned to the client
;; doesn't mention that.
(pk 'corrupt c)
(not (zero? (nix-protocol-error-status c)))))
(build-derivations s (list d))
#f))))
(test-assert "substitute --fallback"
(let* ((s (open-connection))
(t (random-text)) ; contents of the output