aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi28
-rwxr-xr-xguix/scripts/substitute.scm134
-rw-r--r--tests/substitute.scm190
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: