futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

substitute: Ignore irrelevant narinfo signatures.

Browse Source 
Fixes <https://bugs.gnu.org/33733>.

Fixes a bug whereby 'guix substitute' would accept narinfos whose
signature does not cover the StorePath/NarHash/References tuple.

* guix/scripts/substitute.scm (narinfo-sha256)[%mandatory-fields]: New
variable.
Compute SIGNED-FIELDS; return #f unless each of the %MANDATORY-FIELDS
is among SIGNED-FIELDS.
 * tests/substitute.scm ("query narinfo with signature over nothing")
("query narinfo with signature over irrelevant bits"): New tests.
This commit is contained in:
Ludovic Courtès 2018-12-13 19:45:47 +01:00
parent 6b34499dc6
commit 60b04024f8
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 52 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/scripts/substitute.scm
View File

@ -392,12 +392,21 @@ No authentication and authorization checks are performed here!"
(define (narinfo-sha256 narinfo)
"Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
'Signature' field."
(define %mandatory-fields
;; List of fields that must be signed. If they are not signed, the
;; narinfo is considered unsigned.
'("StorePath" "NarHash" "References"))
(let ((contents (narinfo-contents narinfo)))
(match (string-contains contents "Signature:")
(#f #f)
(index
(let ((above-signature (string-take contents index)))
(sha256 (string->utf8 above-signature)))))))
(let* ((above-signature (string-take contents index))
(signed-fields (match (call-with-input-string above-signature
fields->alist)
(((fields . values) ...) fields))))
(and (every (cut member <> signed-fields) %mandatory-fields)
(sha256 (string->utf8 above-signature))))))))
(define* (valid-narinfo? narinfo #:optional (acl (current-acl))
#:key verbose?)

42
tests/substitute.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -211,6 +211,46 @@ a file for NARINFO."
(lambda ()
(guix-substitute "--query"))))))))
(test-equal "query narinfo with signature over nothing"
;; The signature is computed over the empty string, not over the important
;; parts, so the narinfo must be ignored.
""
(with-narinfo (string-append "Signature: " (signature-field "") "\n"
%narinfo "\n")
(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 with signature over irrelevant bits"
;; The signature is valid but it does not cover the
;; StorePath/NarHash/References tuple and is thus irrelevant; the narinfo
;; must be ignored.
""
(let ((prefix (string-append "StorePath: " (%store-prefix)
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
URL: example.nar
Compression: none\n")))
(with-narinfo (string-append prefix
"Signature: " (signature-field prefix) "
NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
NarSize: 42
References: bar baz
Deriver: " (%store-prefix) "/foo.drv
System: mips64el-linux\n")
(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")