[bug#53901] [PATCH] publish: Sign only normative narinfo fields.

["Ludovic Courtès" <ludo@gnu.org>]

This will allow mirror operators to alter the non-normative bits of a
narinfo, such as nar URLs and compression methods, without requiring
them 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 | 29 +++++++++++--------
 tests/publish.scm        | 61 ++++++++++++++++++++++++----------------
 tests/substitute.scm     | 25 +++++++++++++++-
 3 files changed, 77 insertions(+), 38 deletions(-)

Hello!

As discussed on IRC and on guix-sysadmin, narinfos currently produced
by ‘guix publish’ includes a signature that covers everything,
including “non-normative” bits such as nar URLs, compression method, etc.:

--8<---------------cut here---------------start------------->8---
$ wget -qO - https://ci.guix.gnu.org/8fpk2cja3f07xls48jfnpgrzrljpqivr.narinfo
StorePath: /gnu/store/8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32
URL: nar/gzip/8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32
Compression: gzip
FileSize: 6337529
URL: nar/lzip/8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32
Compression: lzip
FileSize: 2533971
URL: nar/zstd/8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32
Compression: zstd
FileSize: 2767372
NarHash: sha256:0k0l1x5kxlsd83zg36z8kcwh3xpvfhkw8m1512vv9q2vi9c2lv2h
NarSize: 17180824
References: 094bbaq6glba86h1d4cj16xhdi6fk2jl-gcc-10.3.0-lib 5h2w4qi9hk1qzzgi1w83220ydslinr4s-glibc-2.33 8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32 a38k2v29l6l0iz6pmlk4dmzwdbvl10lq-acl-2.3.1 a7ggx0af69gv4k5mr1k617p4vy9kgx2v-libcap-2.62 fwbiihd2sbhai63y1pvvdh0f2bakfzrf-gmp-6.2.1 jkjs0inmzhj4vsvclbf08nmh0shm7lrf-attr-2.5.1
Deriver: y4qp5kiqg3xhgqyj67xav2ld81wpwsmw-coreutils-8.32.drv
Signature: 1;berlin.guix.gnu.org;KHNpZ25hdHVyZSAKIChkYXRhIAogIChmbGFncyByZmM2OTc5KQogIChoYXNoIHNoYTI1NiAjODQyQjU4MTY5NTEwNkExNUQyRTBDRTgzRDA0MjUxRUMzMDgzMTVCRUIyODQzRkVENkM1RkY0N0I0RjBFRTE5NSMpCiAgKQogKHNpZy12YWwgCiAgKGVjZHNhIAogICAociAjMEE5QUQxNkJDQUExREQ1NkRGRUQ4QTUwQUZBODNFQzlEOUVBNDdFQUVBQUU2OTFBQzk3NDdDNkQ4MDcyOEY5RiMpCiAgIChzICMwM0ZGM0Y3NzJFQkU5OUY2M0YzNTEzMUFBQkY0MUVENzBBRjUwRDE4Mzc2RTM1QzUwN0NEQUQwQUE4NjRFQTk5IykKICAgKQogICkKIChwdWJsaWMta2V5IAogIChlY2MgCiAgIChjdXJ2ZSBFZDI1NTE5KQogICAocSAjOEQxNTZGMjk1RDI0QjBEOUE4NkZBNTc0MUE4NDBGRjJEMjRGNjBGN0I2QzQxMzQ4MTRBRDU1NjI1OTcxQjM5NCMpCiAgICkKICApCiApCg==
--8<---------------cut here---------------end--------------->8---

A consequence is that a mirror operator who’d like to, say,
remove some of the compression methods cannot do that, unless they
are in a position to resign narinfos.

This patch fixes it by computing the signature over the normative
fields only (plus the “Deriver” field, although it’s not strictly
necessary).  The result looks like this:

--8<---------------cut here---------------start------------->8---
$ wget -qO - http://localhost:9999/8fpk2cja3f07xls48jfnpgrzrljpqivr.narinfo
StorePath: /gnu/store/8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32
NarHash: sha256:0k0l1x5kxlsd83zg36z8kcwh3xpvfhkw8m1512vv9q2vi9c2lv2h
NarSize: 17180824
References: 094bbaq6glba86h1d4cj16xhdi6fk2jl-gcc-10.3.0-lib 5h2w4qi9hk1qzzgi1w83220ydslinr4s-glibc-2.33 8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32 a38k2v29l6l0iz6pmlk4dmzwdbvl10lq-acl-2.3.1 a7ggx0af69gv4k5mr1k617p4vy9kgx2v-libcap-2.62 fwbiihd2sbhai63y1pvvdh0f2bakfzrf-gmp-6.2.1 jkjs0inmzhj4vsvclbf08nmh0shm7lrf-attr-2.5.1
Deriver: y4qp5kiqg3xhgqyj67xav2ld81wpwsmw-coreutils-8.32.drv
Signature: 1;ribbon;KHNpZ25hdHVyZSAKIChkYXRhIAogIChmbGFncyByZmM2OTc5KQogIChoYXNoIHNoYTI1NiAjOEM1OUFEMjYzNEY4MDU3REI0NTUzQkMxM0RFRUM0QkQ2NDYwRDMzMzFDOEJBN0Q5MTgwOEI4QjdDQUFGMEREMCMpCiAgKQogKHNpZy12YWwgCiAgKGVjZHNhIAogICAociAjMEYxQkZDQUM3QzcyNEZERjU4QTA1REU4NTU5NkIyRTYxOEE4OTQ4QkJCMUQ2NEUzMkM4QUE3OTlFNEU0NEIzMCMpCiAgIChzICMwMUREMkU1RTZDRkQwNURGNkI2OEM2OUEwMERBRjU2QUUwMkQ5RTRDQ0E1QjQ3RUJBNUY1MzNCMTBBMDNBMzdBIykKICAgKQogICkKIChwdWJsaWMta2V5IAogIChlY2MgCiAgIChjdXJ2ZSBFZDI1NTE5KQogICAocSAjNDYwQzg2OEJGQkM2REI2Q0JEMTdDRUZGMjE1MkFCRENDNjdFRDg5MTk1MzE2MURCN0ZBODkyQ0JBM0MxM0IwRiMpCiAgICkKICApCiApCg==
URL: nar/gzip/8fpk2cja3f07xls48jfnpgrzrljpqivr-coreutils-8.32
Compression: gzip
--8<---------------cut here---------------end--------------->8---

Notice that URL/Compression come after the signature.

I added a test to ‘tests/substitute.scm’ to be entirely sure
that (guix narinfo) handles these correctly.

Thoughts?

Thanks,
Ludo’.

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 6e2b4368da..870dfc11e9 100644
--- a/guix/scripts/publish.scm
+++ b/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 @@ (define* (narinfo-string store store-path
          (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 @@ (define* (narinfo-string store store-path
                                  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")
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 @@ (define %gzip-magic-bytes
          (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 @@ (define %gzip-magic-bytes
                      (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 @@ (define %gzip-magic-bytes
          (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 @@ (define %gzip-magic-bytes
                      (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 @@ (define %gzip-magic-bytes
               (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 @@ (define %gzip-magic-bytes
                                              (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 @@ (define-syntax-rule (with-narinfo* narinfo directory body ...)
              (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")
 
-- 
2.34.0