01/01: substitute: Ignore irrelevant narinfo signatures.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 60b04024f8823192b74c1ed5b14f318049865ac7
Author: Ludovic Courtès <address@hidden>
Date:   Thu Dec 13 19:45:47 2018 +0100

    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.
---
 guix/scripts/substitute.scm | 13 +++++++++++--
 tests/substitute.scm        | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 52 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index d6dc9b6..53b1777 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?)
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 964a57f..f4f2e95 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Nikita Karetnikov <address@hidden>
-;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2014, 2015, 2017, 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -211,6 +211,46 @@ a file for NARINFO."
            (lambda ()
              (guix-substitute "--query"))))))))
 
+(test-equal "query narinfo with signature over nothing"
+  ;; The signature is computed over the empty string, not over the important
+  ;; parts, so the narinfo must be ignored.
+  ""
+
+  (with-narinfo (string-append "Signature: " (signature-field "") "\n"
+                                %narinfo "\n")
+    (string-trim-both
+     (with-output-to-string
+       (lambda ()
+         (with-input-from-string (string-append "have " (%store-prefix)
+                                                
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+           (lambda ()
+             (guix-substitute "--query"))))))))
+
+(test-equal "query narinfo with signature over irrelevant bits"
+  ;; The signature is valid but it does not cover the
+  ;; StorePath/NarHash/References tuple and is thus irrelevant; the narinfo
+  ;; must be ignored.
+  ""
+
+  (let ((prefix (string-append "StorePath: " (%store-prefix)
+                               "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+URL: example.nar
+Compression: none\n")))
+    (with-narinfo (string-append prefix
+                                 "Signature: " (signature-field prefix) "
+NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+NarSize: 42
+References: bar baz
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")
+      (string-trim-both
+       (with-output-to-string
+         (lambda ()
+           (with-input-from-string (string-append "have " (%store-prefix)
+                                                  
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+             (lambda ()
+               (guix-substitute "--query")))))))))
+
 (test-equal "query narinfo signed with authorized key"
   (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")