aboutsummaryrefslogtreecommitdiff
path: root/tests/publish.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-02-09 18:36:35 +0100
committerLudovic Courtès <ludo@gnu.org>2022-02-14 11:23:56 +0100
commit6adce1538d2df6fa2d68abc13ae94e2fa826d124 (patch)
tree082b9a1355cdb8a321a11f312ef2b2d9ed0a57ec /tests/publish.scm
parentca87601dd97dd9d356409827802eb0f8a3a535f0 (diff)
downloadguix-6adce1538d2df6fa2d68abc13ae94e2fa826d124.tar
guix-6adce1538d2df6fa2d68abc13ae94e2fa826d124.tar.gz
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.
Diffstat (limited to 'tests/publish.scm')
-rw-r--r--tests/publish.scm61
1 files changed, 36 insertions, 25 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