diff options
| -rw-r--r-- | doc/guix.texi | 28 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 134 | ||||
| -rw-r--r-- | tests/substitute.scm | 190 |
3 files changed, 290 insertions, 62 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 0399c39814..c5b277d027 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2143,6 +2143,8 @@ your system has unpatched security vulnerabilities. @cindex security @cindex digital signatures @cindex substitutes, authorization thereof +@cindex access control list (ACL), for substitutes +@cindex ACL (access control list), for substitutes To allow Guix to download substitutes from @code{hydra.gnu.org} or a mirror thereof, you must add its public key to the access control list (ACL) of archive @@ -2191,9 +2193,29 @@ The following files would be downloaded: This indicates that substitutes from @code{hydra.gnu.org} are usable and will be downloaded, when possible, for future builds. -Guix ignores substitutes that are not signed, or that are not signed by -one of the keys listed in the ACL. It also detects and raises an error -when attempting to use a substitute that has been tampered with. +Guix detects and raises an error when attempting to use a substitute +that has been tampered with. Likewise, it ignores substitutes that are +not signed, or that are not signed by one of the keys listed in the ACL. + +There is one exception though: if an unauthorized server provides +substitutes that are @emph{bit-for-bit identical} to those provided by +an authorized server, then the unauthorized server becomes eligible for +downloads. For example, assume we have chosen two substitute servers +with this option: + +@example +--substitute-urls="https://a.example.org https://b.example.org" +@end example + +@noindent +@cindex reproducible builds +If the ACL contains only the key for @code{b.example.org}, and if +@code{a.example.org} happens to serve the @emph{exact same} substitutes, +then Guix will download substitutes from @code{a.example.org} because it +comes first in the list and can be considered a mirror of +@code{b.example.org}. In practice, independent build machines usually +produce the same binaries, thanks to bit-reproducible builds (see +below). @vindex http_proxy Substitutes are downloaded over HTTP or HTTPS. diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 592c497322..dd49cf15f3 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -78,7 +78,6 @@ narinfo-signature narinfo-hash->sha256 - assert-valid-narinfo lookup-narinfos lookup-narinfos/diverse @@ -407,38 +406,41 @@ No authentication and authorization checks are performed here!" (let ((above-signature (string-take contents index))) (sha256 (string->utf8 above-signature))))))) -(define* (assert-valid-narinfo narinfo - #:optional (acl (current-acl)) - #:key verbose?) - "Raise an exception if NARINFO lacks a signature, has an invalid signature, -or is signed by an unauthorized key." - (let ((hash (narinfo-sha256 narinfo))) - (if (not hash) - (if %allow-unauthenticated-substitutes? - narinfo - (leave (G_ "substitute at '~a' lacks a signature~%") - (uri->string (narinfo-uri narinfo)))) - (let ((signature (narinfo-signature narinfo))) - (unless %allow-unauthenticated-substitutes? - (assert-valid-signature narinfo signature hash acl) - (when verbose? - (format (current-error-port) - (G_ "Found valid signature for ~a~%") - (narinfo-path narinfo)) - (format (current-error-port) - (G_ "From ~a~%") - (uri->string (narinfo-uri narinfo))))) - narinfo)))) - -(define* (valid-narinfo? narinfo #:optional (acl (current-acl))) +(define* (valid-narinfo? narinfo #:optional (acl (current-acl)) + #:key verbose?) "Return #t if NARINFO's signature is not valid." (or %allow-unauthenticated-substitutes? (let ((hash (narinfo-sha256 narinfo)) - (signature (narinfo-signature narinfo))) + (signature (narinfo-signature narinfo)) + (uri (uri->string (narinfo-uri narinfo)))) (and hash signature (signature-case (signature hash acl) (valid-signature #t) - (else #f)))))) + (invalid-signature + (when verbose? + (format (current-error-port) + "invalid signature for substitute at '~a'~%" + uri)) + #f) + (hash-mismatch + (when verbose? + (format (current-error-port) + "hash mismatch for substitute at '~a'~%" + uri)) + #f) + (unauthorized-key + (when verbose? + (format (current-error-port) + "substitute at '~a' is signed by an \ +unauthorized party~%" + uri)) + #f) + (corrupt-signature + (when verbose? + (format (current-error-port) + "corrupt signature for substitute at '~a'~%" + uri)) + #f)))))) (define (write-narinfo narinfo port) "Write NARINFO to PORT." @@ -708,30 +710,68 @@ information is available locally." (let ((missing (fetch-narinfos cache missing))) (append cached (or missing '())))))) -(define (lookup-narinfos/diverse caches paths) +(define (equivalent-narinfo? narinfo1 narinfo2) + "Return true if NARINFO1 and NARINFO2 are equivalent--i.e., if they describe +the same store item. This ignores unnecessary metadata such as the Nar URL." + (and (string=? (narinfo-hash narinfo1) + (narinfo-hash narinfo2)) + + ;; The following is not needed if all we want is to download a valid + ;; nar, but it's necessary if we want valid narinfo. + (string=? (narinfo-path narinfo1) + (narinfo-path narinfo2)) + (equal? (narinfo-references narinfo1) + (narinfo-references narinfo2)) + + (= (narinfo-size narinfo1) + (narinfo-size narinfo2)))) + +(define (lookup-narinfos/diverse caches paths authorized?) "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order. -That is, when a cache lacks a narinfo, look it up in the next cache, and so -on. Return a list of narinfos for PATHS or a subset thereof." +That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next +cache, and so on. + +Return a list of narinfos for PATHS or a subset thereof. The returned +narinfos are either AUTHORIZED?, or they claim a hash that matches an +AUTHORIZED? narinfo." + (define (select-hit result) + (lambda (path) + (match (vhash-fold* cons '() path result) + ((one) + one) + ((several ..1) + (let ((authorized (find authorized? (reverse several)))) + (and authorized + (find (cut equivalent-narinfo? <> authorized) + several))))))) + (let loop ((caches caches) (paths paths) - (result '())) + (result vlist-null) ;path->narinfo vhash + (hits '())) ;paths (match paths (() ;we're done - result) + ;; Now iterate on all the HITS, and return exactly one match for each + ;; hit: the first narinfo that is authorized, or that has the same hash + ;; as an authorized narinfo, in the order of CACHES. + (filter-map (select-hit result) hits)) (_ (match caches ((cache rest ...) (let* ((narinfos (lookup-narinfos cache paths)) - (hits (map narinfo-path narinfos)) - (missing (lset-difference string=? paths hits))) ;XXX: perf - (loop rest missing (append narinfos result)))) + (definite (map narinfo-path (filter authorized? narinfos))) + (missing (lset-difference string=? paths definite))) ;XXX: perf + (loop rest missing + (fold vhash-cons result + (map narinfo-path narinfos) narinfos) + (append definite hits)))) (() ;that's it - result)))))) + (filter-map (select-hit result) hits))))))) -(define (lookup-narinfo caches path) +(define (lookup-narinfo caches path authorized?) "Return the narinfo for PATH in CACHES, or #f when no substitute for PATH was found." - (match (lookup-narinfos/diverse caches (list path)) + (match (lookup-narinfos/diverse caches (list path) authorized?) ((answer) answer) (_ #f))) @@ -868,15 +908,15 @@ authorized substitutes." (match (string-tokenize command) (("have" paths ..1) ;; Return the subset of PATHS available in CACHE-URLS. - (let ((substitutable (lookup-narinfos/diverse cache-urls paths))) + (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid?))) (for-each (lambda (narinfo) (format #t "~a~%" (narinfo-path narinfo))) - (filter valid? substitutable)) + substitutable) (newline))) (("info" paths ..1) ;; Reply info about PATHS if it's in CACHE-URLS. - (let ((substitutable (lookup-narinfos/diverse cache-urls paths))) - (for-each display-narinfo-data (filter valid? substitutable)) + (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid?))) + (for-each display-narinfo-data substitutable) (newline))) (wtf (error "unknown `--query' command" wtf)))) @@ -885,10 +925,12 @@ authorized substitutes." #:key cache-urls acl) "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to DESTINATION as a nar file. Verify the substitute against ACL." - (let* ((narinfo (lookup-narinfo cache-urls store-item)) - (uri (narinfo-uri narinfo))) - ;; Make sure it is signed and everything. - (assert-valid-narinfo narinfo acl) + (let* ((narinfo (lookup-narinfo cache-urls store-item + (cut valid-narinfo? <> acl))) + (uri (and=> narinfo narinfo-uri))) + (unless uri + (leave (G_ "no valid substitute for '~a'~%") + store-item)) ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) diff --git a/tests/substitute.scm b/tests/substitute.scm index b1d0fe9316..0ad6247954 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,7 +28,9 @@ #:use-module (guix base32) #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix ui) #:select (guix-warning-port)) - #:use-module ((guix build utils) #:select (delete-file-recursively)) + #:use-module ((guix build utils) + #:select (mkdir-p delete-file-recursively)) + #:use-module (guix tests http) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (web uri) @@ -112,6 +114,15 @@ version identifier.." +(define %main-substitute-directory + ;; The place where 'call-with-narinfo' stores its data by default. + (uri-path (string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL")))) + +(define %alternate-substitute-directory + ;; Another place. + (string-append (dirname %main-substitute-directory) + "/substituter-alt-data")) + (define %narinfo ;; Skeleton of the narinfo used below. (string-append "StorePath: " (%store-prefix) @@ -125,14 +136,14 @@ References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n")) -(define (call-with-narinfo narinfo thunk) - "Call THUNK in a context where $GUIX_BINARY_SUBSTITUTE_URL is populated with +(define* (call-with-narinfo narinfo thunk + #:optional + (narinfo-directory %main-substitute-directory)) + "Call THUNK in a context where the directory at URL is populated with a file for NARINFO." - (let ((narinfo-directory (and=> (string->uri (getenv - "GUIX_BINARY_SUBSTITUTE_URL")) - uri-path)) - (cache-directory (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute/"))) + (mkdir-p narinfo-directory) + (let ((cache-directory (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute/"))) (dynamic-wind (lambda () (when (file-exists? cache-directory) @@ -161,11 +172,15 @@ a file for NARINFO." #f)) thunk (lambda () - (delete-file-recursively cache-directory))))) + (when (file-exists? cache-directory) + (delete-file-recursively cache-directory)))))) (define-syntax-rule (with-narinfo narinfo body ...) (call-with-narinfo narinfo (lambda () body ...))) +(define-syntax-rule (with-narinfo* narinfo directory body ...) + (call-with-narinfo narinfo (lambda () body ...) directory)) + ;; Transmit these options to 'guix substitute'. (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) @@ -227,7 +242,7 @@ a file for NARINFO." (guix-substitute "--query")))))))) (test-quit "substitute, no signature" - "lacks a signature" + "no valid substitute" (with-narinfo %narinfo (guix-substitute "--substitute" (string-append (%store-prefix) @@ -235,7 +250,7 @@ a file for NARINFO." "foo"))) (test-quit "substitute, invalid hash" - "hash" + "no valid substitute" ;; The hash in the signature differs from the hash of %NARINFO. (with-narinfo (string-append %narinfo "Signature: " (signature-field "different body") @@ -246,7 +261,7 @@ a file for NARINFO." "foo"))) (test-quit "substitute, unauthorized key" - "unauthorized" + "no valid substitute" (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo @@ -272,9 +287,158 @@ a file for NARINFO." (lambda () (false-if-exception (delete-file "substitute-retrieved")))))) +(test-equal "substitute, unauthorized narinfo comes first" + "Substitutable data." + (with-narinfo* + (string-append %narinfo "Signature: " + (signature-field + %narinfo + #:public-key %wrong-public-key)) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; Remove this file so that the substitute can only be retrieved + ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %main-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-equal "substitute, unsigned narinfo comes first" + "Substitutable data." + (with-narinfo* %narinfo ;not signed! + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; Remove this file so that the substitute can only be retrieved + ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %main-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-equal "substitute, first narinfo is unsigned and has wrong hash" + "Substitutable data." + (with-narinfo* (regexp-substitute #f + (string-match "NarHash: [[:graph:]]+" + %narinfo) + 'pre + "NarHash: sha256:" + (bytevector->nix-base32-string + (make-bytevector 32)) + 'post) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; This time remove the file so that the substitute can only be + ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %alternate-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-equal "substitute, first narinfo is unsigned and has wrong refs" + "Substitutable data." + (with-narinfo* (regexp-substitute #f + (string-match "References: ([^\n]+)\n" + %narinfo) + 'pre "References: " 1 + " wrong set of references\n" + 'post) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; This time remove the file so that the substitute can only be + ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %alternate-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-quit "substitute, two invalid narinfos" + "no valid substitute" + (with-narinfo* %narinfo ;not signed + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " ;unauthorized + (signature-field + %narinfo + #:public-key %wrong-public-key)) + %main-substitute-directory + + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")))) + (test-end "substitute") ;;; Local Variables: ;;; eval: (put 'with-narinfo 'scheme-indent-function 1) +;;; eval: (put 'with-narinfo* 'scheme-indent-function 2) ;;; eval: (put 'test-quit 'scheme-indent-function 2) ;;; End: |