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.

guix/scripts/publish.scm

@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
@@ -345,20 +345,10 @@ much needs to be downloaded."
          (base-info  (format #f
                              "\
 StorePath: ~a
-~{~a~}\
 NarHash: sha256:~a
 NarSize: ~d
 References: ~a~%"
                              store-path
-                             (map (lambda (compression)
-                                    (let ((size (assoc-ref file-sizes
-                                                           compression)))
-                                      (store-item->recutils store-path
-                                                            #:file-size size
-                                                            #:nar-path nar-path
-                                                            #:compression
-                                                            compression)))
-                                  compressions)
                              hash size references))
          ;; Do not render a "Deriver" line if we are rendering info for a
          ;; derivation.  Also do not render a "System" line that would be
@@ -369,7 +359,22 @@ References: ~a~%"
                                  base-info (basename deriver))))
          (signature  (base64-encode-string
                       (canonical-sexp->string (signed-string info)))))
-    (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
+    (format #f "~aSignature: 1;~a;~a~%~{~a~}"
+            info (gethostname) signature
+
+            ;; Move information about the actual nars
+            ;; (URL/Compression/FileSize) *after* the normative part that is
+            ;; signed.  That makes it possible to alter these bits of the
+            ;; narinfo without having to resign them.
+            (map (lambda (compression)
+                   (let ((size (assoc-ref file-sizes
+                                          compression)))
+                     (store-item->recutils store-path
+                                           #:file-size size
+                                           #:nar-path nar-path
+                                           #:compression
+                                           compression)))
+                 compressions))))
 
 (define* (not-found request
                     #:key (phrase "Resource not found")

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~%"
+    (format #f "~aSignature: 1;~a;~a
-            unsigned-info (gethostname) signature))
+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~%"
+    (format #f "~aSignature: 1;~a;~a
-            unsigned-info (gethostname) signature))
+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)
+                (match (pk 'narinfo/gzip+lzip narinfo)
-                        `(("StorePath" . ,%item)
+                  ((("StorePath" . path)
-                          ("URL" . ,(nar-url "gzip"))
+                    _ ...
-                          ("Compression" . "gzip")
+                    ("Signature" . _)
-                          ("FileSize" . ,(number->string
+                    ("URL" . gzip-url)
-                                          (stat:size (stat (nar "gzip")))))
+                    ("Compression" . "gzip")
-                          ("URL" . ,(nar-url "lzip"))
+                    ("FileSize" . (= string->number gzip-size))
-                          ("Compression" . "lzip")
+                    ("URL" . lzip-url)
-                          ("FileSize" . ,(number->string
+                    ("Compression" . "lzip")
-                                          (stat:size (stat (nar "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

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")