diff options
| -rw-r--r-- | tests/store.scm | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/tests/store.scm b/tests/store.scm index d23024bcbc..3932a8eb45 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -374,6 +374,64 @@ Deriver: ~a~%" (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 |