summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/publish.scm29
-rw-r--r--tests/publish.scm61
-rw-r--r--tests/substitute.scm25
3 files changed, 77 insertions, 38 deletions
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 @@ 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")
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")