ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Check the build trace for hash mismatches on substitutes.

Browse source 
* tests/store.scm ("substitute, corrupt output hash, build trace"): New
test.
This commit is contained in:
Ludovic Courtès 2020-12-13 22:20:08 +01:00
parent f6f6e1efee
commit 6d955f1731
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 55 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
tests/store.scm
View file

@ -787,6 +787,61 @@ (define (same? x y)
(build-derivations s (list d))
#f))))))
(test-assert "substitute, corrupt output hash, build trace"
;; Likewise, and check the build trace.
(with-store s
(let* ((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)))
;; Make sure we use 'guix substitute'.
(set-build-options s
#:print-build-trace #t
#:use-substitutes? #t
#:fallback? #f
#:substitute-urls (%test-substitute-urls))
(with-derivation-substitute d c
(sha256 => (make-bytevector 32 0)) ;select a hash that doesn't match C
(define output
(call-with-output-string
(lambda (port)
(parameterize ((current-build-output-port port))
(guard (c ((store-protocol-error? c) #t))
(build-derivations s (list d))
#f)))))
(define actual-hash
(let-values (((port get-hash)
(gcrypt:open-hash-port
(gcrypt:hash-algorithm gcrypt:sha256))))
(write-file-tree "foo" port
#:file-type+size
(lambda _
(values 'regular (string-length c)))
#:file-port
(lambda _
(open-input-string c)))
(close-port port)
(bytevector->nix-base32-string (get-hash))))
(define expected-hash
(bytevector->nix-base32-string (make-bytevector 32 0)))
(define mismatch
(string-append "@ hash-mismatch " o " sha256 "
expected-hash " " actual-hash "\n"))
(define failure
(string-append "@ substituter-failed " o))
(and (string-contains output mismatch)
(string-contains output failure))))))
(test-assert "substitute --fallback"
(with-store s
(let* ((t (random-text)) ; contents of the output