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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 5d24e57a611b43ff68700379338b899f62d198cc
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Jan 9 15:33:16 2023 +0100

    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.
---
 guix/derivations.scm  | 10 +++++++---
 tests/derivations.scm | 40 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 46 insertions(+), 4 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 354ec20e3f..0bb6a28147 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1,5 +1,5 @@
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -484,17 +484,21 @@ things as appropriate and is thus more efficient."
     (fold-right (lambda (output result)
                   (match output
                     ((name path "" "")
+                     ;; Regular derivation.
                      (alist-cons name
                                  (make-derivation-output path #f #f #f)
                                  result))
                     ((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))
                             (algo (string->symbol
                                    (if rec?
                                        (string-drop hash-algo 2)
                                        hash-algo)))
-                            (hash (base16-string->bytevector hash)))
+                            (hash (and (not (string-null? hash))
+                                       (base16-string->bytevector hash))))
                        (alist-cons name
                                    (make-derivation-output path algo
                                                            hash rec?)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 3912fd31d8..3d25365b14 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -256,6 +256,21 @@
       (build-derivations %store (list drv))
       #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"
   ;; Make sure rebuilding the 'builtin:download' derivation in check mode
   ;; works.  See <http://bugs.gnu.org/25089>.
@@ -316,6 +331,13 @@
                                  #:hash hash #:hash-algo 'sha256)))
     (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"
   '(sha1 sha256 sha512)
   (map (lambda (hash-algorithm)
@@ -543,6 +565,22 @@
                     read-derivation)))
     (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"
   (let* ((builder    (add-text-to-store %store "builder.sh"
                                         "echo one > $out ; echo two > $second"