publish: Do not sign the URL/Compression/FileSize narinfo fields.

This will allow mirror operators to alter these non-normative bits of a
narinfo without having to resign narinfos.

* guix/scripts/publish.scm (narinfo-string): Remove
URL/Compression/FileSize from BASE-INFO.  Move them after "Signature".
* tests/publish.scm ("/*.narinfo")
("/*.narinfo with properly encoded '+' sign")
("/*.narinfo with lzip + gzip")
("with cache, lzip + gzip"): Adjust accordingly.
* tests/substitute.scm ("query narinfo with signature over relevant subset"):
New test.

2 files changed, 60 insertions, 26 deletions

diff --git a/tests/publish.scm b/tests/publish.scm
index e3c27c5eea..47c5eabca0 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -142,15 +142,10 @@
          (unsigned-info
           (format #f
                   "StorePath: ~a
-URL: nar/~a
-Compression: none
-FileSize: ~a
 NarHash: sha256:~a
 NarSize: ~d
 References: ~a~%"
                   %item
-                  (basename %item)
-                  (path-info-nar-size info)
                   (bytevector->nix-base32-string
                    (path-info-hash info))
                   (path-info-nar-size info)
@@ -159,8 +154,13 @@ References: ~a~%"
                      (string->utf8
                       (canonical-sexp->string
                        (signed-string unsigned-info))))))
-    (format #f "~aSignature: 1;~a;~a~%"
-            unsigned-info (gethostname) signature))
+    (format #f "~aSignature: 1;~a;~a
+URL: nar/~a
+Compression: none
+FileSize: ~a\n"
+            unsigned-info (gethostname) signature
+            (basename %item)
+            (path-info-nar-size info)))
   (utf8->string
    (http-get-body
     (publish-uri
@@ -173,15 +173,10 @@ References: ~a~%"
          (unsigned-info
           (format #f
                   "StorePath: ~a
-URL: nar/~a
-Compression: none
-FileSize: ~a
 NarHash: sha256:~a
 NarSize: ~d
 References: ~%"
                   item
-                  (uri-encode (basename item))
-                  (path-info-nar-size info)
                   (bytevector->nix-base32-string
                    (path-info-hash info))
                   (path-info-nar-size info)))
@@ -189,8 +184,13 @@ References: ~%"
                      (string->utf8
                       (canonical-sexp->string
                        (signed-string unsigned-info))))))
-    (format #f "~aSignature: 1;~a;~a~%"
-            unsigned-info (gethostname) signature))
+    (format #f "~aSignature: 1;~a;~a
+URL: nar/~a
+Compression: none
+FileSize: ~a~%"
+            unsigned-info (gethostname) signature
+            (uri-encode (basename item))
+            (path-info-nar-size info)))
 
   (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
     (utf8->string
@@ -324,7 +324,12 @@ References: ~%"
               (part (store-path-hash-part %item))
               (url  (string-append base part ".narinfo"))
               (body (http-get-port url)))
-         (list (take (recutils->alist body) 5)
+         (list (filter (match-lambda
+                         (("StorePath" . _) #t)
+                         (("URL" . _) #t)
+                         (("Compression" . _) #t)
+                         (_ #f))
+                       (recutils->alist body))
                (response-code
                 (http-get (string-append base "nar/gzip/"
                                          (basename %item))))
@@ -504,16 +509,22 @@ References: ~%"
                                              (basename %item))))
            (and (file-exists? (nar "gzip"))
                 (file-exists? (nar "lzip"))
-                (equal? (take (pk 'narinfo/gzip+lzip narinfo) 7)
-                        `(("StorePath" . ,%item)
-                          ("URL" . ,(nar-url "gzip"))
-                          ("Compression" . "gzip")
-                          ("FileSize" . ,(number->string
-                                          (stat:size (stat (nar "gzip")))))
-                          ("URL" . ,(nar-url "lzip"))
-                          ("Compression" . "lzip")
-                          ("FileSize" . ,(number->string
-                                          (stat:size (stat (nar "lzip")))))))
+                (match (pk 'narinfo/gzip+lzip narinfo)
+                  ((("StorePath" . path)
+                    _ ...
+                    ("Signature" . _)
+                    ("URL" . gzip-url)
+                    ("Compression" . "gzip")
+                    ("FileSize" . (= string->number gzip-size))
+                    ("URL" . lzip-url)
+                    ("Compression" . "lzip")
+                    ("FileSize" . (= string->number lzip-size)))
+                   (and (string=? gzip-url (nar-url "gzip"))
+                        (string=? lzip-url (nar-url "lzip"))
+                        (= gzip-size
+                           (stat:size (stat (nar "gzip"))))
+                        (= lzip-size
+                           (stat:size (stat (nar "lzip")))))))
                 (list (response-code
                        (http-get (string-append base (nar-url "gzip"))))
                       (response-code
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 21b513e1d8..049e6ba762 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014, 2015, 2017, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2015, 2017-2019, 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -268,6 +268,29 @@ System: mips64el-linux\n")
              (lambda ()
                (guix-substitute "--query")))))))))
 
+(test-equal "query narinfo with signature over relevant subset"
+  ;; The signature covers the StorePath/NarHash/References tuple, so it is
+  ;; valid; it does not cover non-normative fields, which is fine.
+  (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+
+  (let ((prefix (string-append "StorePath: " (%store-prefix)
+                               "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+References: bar baz\n")))
+    (with-narinfo (string-append prefix
+                                 "Signature: " (signature-field prefix) "
+URL: example.nar
+Compression: none
+NarSize: 42
+Deriver: " (%store-prefix) "/foo.drv")
+      (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")