diff options
| -rw-r--r-- | guix/scripts/publish.scm | 29 | ||||
| -rw-r--r-- | tests/publish.scm | 61 | ||||
| -rw-r--r-- | tests/substitute.scm | 25 |
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") |