From 6adce1538d2df6fa2d68abc13ae94e2fa826d124 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 9 Feb 2022 18:36:35 +0100
Subject: 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.
---
 tests/publish.scm | 61 ++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 36 insertions(+), 25 deletions(-)

(limited to 'tests/publish.scm')

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
-- 
cgit v1.2.3