me
/
guix
Archived
1
0
Fork 0
Code

derivations: 'read-derivation' correctly handles case with empty hash. 

Reported by Stephen Paul Weber <singpolyma@singpolyma.net> at
<https://lists.gnu.org/archive/html/guix-devel/2023-01/msg00035.html>.

* guix/derivations.scm (read-derivation)[outputs->alist]: Treat the
empty hash case as non-fixed-output whether or not the hash algorithm is
the empty string, and preserve the hash algorithm in <derivation-output>.
* tests/derivations.scm ("'download' built-in builder, no fixed-output hash")
("fixed-output-derivation?, no hash", "read-derivation with hash = #f"): New tests.
master
Ludovic Courtès 2023-01-09 15:33:16 +01:00
parent 007e697560
commit 5d24e57a61
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 46 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
guix/derivations.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -484,17 +484,21 @@ things as appropriate and is thus more efficient."
(fold-right (lambda (output result) (fold-right (lambda (output result)
(match output (match output
((name path "" "") ((name path "" "")
;; Regular derivation.
(alist-cons name (alist-cons name
(make-derivation-output path #f #f #f) (make-derivation-output path #f #f #f)
result)) result))
((name path hash-algo hash) ((name path hash-algo hash)
;; fixed-output ;; Fixed-output, unless HASH is the empty string (in that
;; case, HASH-ALGO must be preserved despite being
;; unused).
(let* ((rec? (string-prefix? "r:" hash-algo)) (let* ((rec? (string-prefix? "r:" hash-algo))
(algo (string->symbol (algo (string->symbol
(if rec? (if rec?
(string-drop hash-algo 2) (string-drop hash-algo 2)
hash-algo))) hash-algo)))
(hash (base16-string->bytevector hash))) (hash (and (not (string-null? hash))
(base16-string->bytevector hash))))
(alist-cons name (alist-cons name
(make-derivation-output path algo (make-derivation-output path algo
hash rec?) hash rec?)

40
tests/derivations.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -256,6 +256,21 @@
(build-derivations %store (list drv)) (build-derivations %store (list drv))
#f))) #f)))
(test-assert "'download' built-in builder, no fixed-output hash"
;; 'guix perform-download' should bail out with a message saying "not a
;; fixed-output derivation".
(with-http-server '((200 "This should not be downloaded."))
(let* ((drv (derivation %store "download-without-hash"
"builtin:download" '()
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
#:hash #f)))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f))))
(test-assert "'download' built-in builder, check mode" (test-assert "'download' built-in builder, check mode"
;; Make sure rebuilding the 'builtin:download' derivation in check mode ;; Make sure rebuilding the 'builtin:download' derivation in check mode
;; works. See <http://bugs.gnu.org/25089>. ;; works. See <http://bugs.gnu.org/25089>.
@ -316,6 +331,13 @@
#:hash hash #:hash-algo 'sha256))) #:hash hash #:hash-algo 'sha256)))
(fixed-output-derivation? drv))) (fixed-output-derivation? drv)))
(test-assert "fixed-output-derivation?, no hash"
;; A derivation that has #:hash-algo and #:hash #f is *not* fixed-output.
(let* ((drv (derivation %store "not-quite-fixed"
"builtin:download" '()
#:hash #f #:hash-algo 'sha256)))
(not (fixed-output-derivation? drv))))
(test-equal "fixed-output derivation" (test-equal "fixed-output derivation"
'(sha1 sha256 sha512) '(sha1 sha256 sha512)
(map (lambda (hash-algorithm) (map (lambda (hash-algorithm)
@ -543,6 +565,22 @@
read-derivation))) read-derivation)))
(equal? drv* drv))) (equal? drv* drv)))
(test-assert "read-derivation with hash = #f"
;; Passing #:hash-algo together with #:hash #f is accepted and #:hash-algo
;; is preserved. However it is not a fixed-output derivation. It used to
;; be that 'read-derivation' would incorrectly return #vu8() instead of #f
;; for the hash in this case:
;; <https://lists.gnu.org/archive/html/guix-devel/2023-01/msg00040.html>.
(let* ((drv1 (derivation %store "almost-fixed-output"
"builtin:download" '()
#:env-vars `(("url" . "http://example.org"))
#:hash-algo 'sha256
#:hash #f))
(drv2 (call-with-input-file (derivation-file-name drv1)
read-derivation)))
(and (not (eq? drv1 drv2)) ;ensure memoization doesn't kick in
(equal? drv1 drv2))))
(test-assert "multiple-output derivation, derivation-path->output-path" (test-assert "multiple-output derivation, derivation-path->output-path"
(let* ((builder (add-text-to-store %store "builder.sh" (let* ((builder (add-text-to-store %store "builder.sh"
"echo one > $out ; echo two > $second" "echo one > $out ; echo two > $second"