substitute: Ignore irrelevant narinfo signatures.

Fixes <https://bugs.gnu.org/33733>.

Fixes a bug whereby 'guix substitute' would accept narinfos whose
signature does not cover the StorePath/NarHash/References tuple.

* guix/scripts/substitute.scm (narinfo-sha256)[%mandatory-fields]: New
variable.
Compute SIGNED-FIELDS; return #f unless each of the %MANDATORY-FIELDS
is among SIGNED-FIELDS.
 * tests/substitute.scm ("query narinfo with signature over nothing")
("query narinfo with signature over irrelevant bits"): New tests.

1 files changed, 11 insertions, 2 deletions

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index d6dc9b6448..53b1777241 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -392,12 +392,21 @@ No authentication and authorization checks are performed here!"
 (define (narinfo-sha256 narinfo)
   "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
 'Signature' field."
+  (define %mandatory-fields
+    ;; List of fields that must be signed.  If they are not signed, the
+    ;; narinfo is considered unsigned.
+    '("StorePath" "NarHash" "References"))
+
   (let ((contents (narinfo-contents narinfo)))
     (match (string-contains contents "Signature:")
       (#f #f)
       (index
-       (let ((above-signature (string-take contents index)))
-         (sha256 (string->utf8 above-signature)))))))
+       (let* ((above-signature (string-take contents index))
+              (signed-fields (match (call-with-input-string above-signature
+                                      fields->alist)
+                               (((fields . values) ...) fields))))
+         (and (every (cut member <> signed-fields) %mandatory-fields)
+              (sha256 (string->utf8 above-signature))))))))
 
 (define* (valid-narinfo? narinfo #:optional (acl (current-acl))
                          #:key verbose?)