GNU bug report logs - #28324
[PATCH 0/2] Allow substitute downloads from unauthorized servers when they are undistinguishable

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 28324 in the body.
You can then email your comments to 28324 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/2] Allow substitute downloads from unauthorized servers when
 they are undistinguishable
Date: Fri,  1 Sep 2017 23:58:12 +0200

Hello Guix!

‘guix publish’ is really helpful, but it’s still inconvenient to share
binaries among machines: one has to authorize the other machine’s key,
which is tedious and is an all-or-nothing kind of decision.

Ideally we’d like to support zero-configuration binary sharing on a
local network, for example, and that means it should Just Work without
having to fiddle with keys/ACLs and without having to give blanket
permission to your colleague’s machine next-door.

This patch allows substitutes to be downloaded from an unauthorized
server (one whose public key is not in /etc/guix/acl), or from a server
that does not even sign substitutes, *provided* that server advertises
and serves the exact same content as one of the authorized servers.

Concretely, here’s the metadata substitute servers provide:

--8<---------------cut here---------------start------------->8---
$ wget -q -O - https://mirror.hydra.gnu.org/sfx1wh27i6gsrk21p87rdyikc64v7d51.narinfo
StorePath: /gnu/store/sfx1wh27i6gsrk21p87rdyikc64v7d51-zlib-1.2.11
URL: guix/nar/gzip/sfx1wh27i6gsrk21p87rdyikc64v7d51-zlib-1.2.11
Compression: gzip
NarHash: sha256:0ac82i3kn10lgb64d3mn0n062rj291bwjpgv7asn32ja4phri463
NarSize: 384240
References: 3x53yv4v144c9xp02rs64z7j597kkqax-gcc-5.4.0-lib n6nvxlk2j8ysffjh3jphn1k5silnakh6-glibc-2.25 sfx1wh27i6gsrk21p87rdyikc64v7d51-zlib-1.2.11
FileSize: 154865
System: x86_64-linux
Deriver: bpxa7iypl2q2fxzf1dgq9k4daa3p3s39-zlib-1.2.11.drv
Signature: 1;20121227-hydra.gnu.org;KHNpZ25…
--8<---------------cut here---------------end--------------->8---

Let’s look at what another server provides for the same item:

--8<---------------cut here---------------start------------->8---
$ wget -q -O - https://berlin.guixsd.org/sfx1wh27i6gsrk21p87rdyikc64v7d51.narinfo
StorePath: /gnu/store/sfx1wh27i6gsrk21p87rdyikc64v7d51-zlib-1.2.11
URL: nar/gzip/sfx1wh27i6gsrk21p87rdyikc64v7d51-zlib-1.2.11
Compression: gzip
NarHash: sha256:0ac82i3kn10lgb64d3mn0n062rj291bwjpgv7asn32ja4phri463
NarSize: 384240
References: 3x53yv4v144c9xp02rs64z7j597kkqax-gcc-5.4.0-lib n6nvxlk2j8ysffjh3jphn1k5silnakh6-glibc-2.25 sfx1wh27i6gsrk21p87rdyikc64v7d51-zlib-1.2.11
FileSize: 154511
System: x86_64-linux
Deriver: 512mdjkpbyp2kggijxcxw0j0xw0scvn4-zlib-1.2.11.drv
Signature: 1;berlin.guixsd.org;KHNpZ25…
--8<---------------cut here---------------end--------------->8---

Apart from the signature, compressed size (“FileSize”), deriver, and
URL, everything is the same.  Thus, even if we only authorized
hydra.gnu.org, it is safe to download from berlin.guixsd.org (in fact,
it’d be enough to have the same “NarHash”) and more generally to
trust the metadata it provides for this store item.

With this patch, one can use:

  --substitute-urls="https://foo.example.org https://hydra.gnu.org"

If foo.example.org serves narinfos equivalent to those of hydra (modulo
signature, URL, compression, etc.), then Guix will download substitutes
from foo.example.org.

Thanks to reproducible builds, that means we’ll effectively be able to
share binaries with pretty much any machine out there.  Pretty neat no?

From there there are several things we can do:

  1. Add optional service discovery support in ‘guix substitute’ and
     service advertisement in ‘guix publish’ via Guile-Avahi.  Imagine
     going to a GHM or FOSDEM and getting binaries from your neighbor’s
     laptop.  I think that’d be pretty cool.  :-)

  2. Change narinfos such that the signature is computed only over the
     relevant parts: StorePath, NarHash, and References (currently it’s
     computed over all the fields up to “Signature”.)  Not strictly
     necessary, but would make sense.

  3. Change ‘guix publish’ to use content-addressed URLs for nars,
     similar to what is done for /file URLs.

  4. Maybe replace --substitute-urls with two options, say
     --metadata-urls and --nar-urls.  You could, say, fetch
     narinfos only from hydra.gnu.org and fetch nars only from
     foo.example.org (using the content-addressed URLs to get nars from
     foo.example.org.)

  5. Add support to download those content-addressed nars over
     Bittorrent, IPFS, and whatnot.  We can keep downloading narinfos
     themselves over HTTPS.

Sky is the limit.

Until then, feedback welcome!  I’d particularly like for people to read
the patch and the associated unit tests; more eyeballs is a good thing.

Ludo’.

Ludovic Courtès (2):
  substitute: Make substitute URLs a SRFI-39 parameter.
  substitute: Download from unauthorized sources that provide the right
    content.

 doc/guix.texi               |  28 ++++++-
 guix/scripts/substitute.scm | 152 ++++++++++++++++++++++------------
 tests/substitute.scm        | 193 ++++++++++++++++++++++++++++++++++++++++----
 3 files changed, 303 insertions(+), 70 deletions(-)

-- 
2.14.1

Message #8 received at 28324 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 28324 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/2] substitute: Make substitute URLs a SRFI-39 parameter.
Date: Sat,  2 Sep 2017 00:06:53 +0200

* guix/scripts/substitute.scm (%cache-urls): Rename to...
(%default-substitute-urls): ... this.
(substitute-urls): New variable.
(guix-substitute): Use it instead of %CACHE-URLS.
* tests/substitute.scm: Likewise.
---
 guix/scripts/substitute.scm | 18 ++++++++++++------
 tests/substitute.scm        |  3 +--
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0d36997bc..592c49732 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -84,6 +84,8 @@
             lookup-narinfos/diverse
             read-narinfo
             write-narinfo
+
+            substitute-urls
             guix-substitute))
 
 ;;; Comment:
@@ -971,7 +973,7 @@ substitutes may be unavailable\n")))))
 found."
   (assoc-ref (daemon-options) option))
 
-(define %cache-urls
+(define %default-substitute-urls
   (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client
                     (find-daemon-option "substitute-urls"))          ;admin
                 string-tokenize)
@@ -982,6 +984,10 @@ found."
      ;; daemon.
      '("http://hydra.gnu.org"))))
 
+(define substitute-urls
+  ;; List of substitute URLs.
+  (make-parameter %default-substitute-urls))
+
 (define (client-terminal-columns)
   "Return the number of columns in the client's terminal, if it is known, or a
 default value."
@@ -1010,15 +1016,15 @@ default value."
   ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
   ;; when we know we cannot substitute, but we must emit a newline on stdout
   ;; when everything is alright.
-  (when (null? %cache-urls)
+  (when (null? (substitute-urls))
     (exit 0))
 
   ;; Say hello (see above.)
   (newline)
   (force-output (current-output-port))
 
-  ;; Sanity-check %CACHE-URLS so we can provide a meaningful error message.
-  (for-each validate-uri %cache-urls)
+  ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
+  (for-each validate-uri (substitute-urls))
 
   ;; Attempt to install the client's locale, mostly so that messages are
   ;; suitably translated.
@@ -1038,7 +1044,7 @@ default value."
             (or (eof-object? command)
                 (begin
                   (process-query command
-                                 #:cache-urls %cache-urls
+                                 #:cache-urls (substitute-urls)
                                  #:acl acl)
                   (loop (read-line)))))))
        (("--substitute" store-path destination)
@@ -1047,7 +1053,7 @@ default value."
         ;; report displays nicely.
         (parameterize ((current-terminal-columns (client-terminal-columns)))
           (process-substitution store-path destination
-                                #:cache-urls %cache-urls
+                                #:cache-urls (substitute-urls)
                                 #:acl (current-acl))))
        (("--version")
         (show-version-and-exit "guix substitute"))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 69b272f2b..b1d0fe931 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -167,8 +167,7 @@ a file for NARINFO."
   (call-with-narinfo narinfo (lambda () body ...)))
 
 ;; Transmit these options to 'guix substitute'.
-(set! (@@ (guix scripts substitute) %cache-urls)
-  (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
+(substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
 
 (test-equal "query narinfo without signature"
   ""                                              ; not substitutable
-- 
2.14.1

Message #11 received at 28324 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 28324 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/2] substitute: Download from unauthorized sources that
 provide the right content.
Date: Sat,  2 Sep 2017 00:06:54 +0200

This allows substitutes to be downloaded from unauthorized servers, as
long as they advertise the same hash and references as one of the
authorized servers.

* guix/scripts/substitute.scm (assert-valid-narinfo): Remove.
(valid-narinfo?): Add #:verbose?.  Handle each case of
'signature-case'.
(equivalent-narinfo?): New procedure.
(lookup-narinfos/diverse): Add 'authorized?' parameter and honor it.
[select-hit]: New procedure.
(lookup-narinfo): Add 'authorized?' parameter and pass it.
(process-query): Adjust callers accordingly.
(process-substitution): Remove call to 'assert-valid-narinfo'.  Check
whether 'lookup-narinfo' returns true and call 'leave' if not.
* tests/substitute.scm (%main-substitute-directory)
(%alternate-substitute-directory): New variables.
(call-with-narinfo): Make 'narinfo-directory' a parameter.  Call
'mkdir-p' to create it.  Change unwind handler to check whether
CACHE-DIRECTORY exists before deleting it.
(with-narinfo*): New macro.
("substitute, no signature")
("substitute, invalid hash")
("substitute, unauthorized key"): Change expected error message to "no
valid substitute".
("substitute, unauthorized narinfo comes first")
("substitute, unsigned narinfo comes first")
("substitute, first narinfo is unsigned and has wrong hash")
("substitute, first narinfo is unsigned and has wrong refs")
("substitute, unsigned narinfo comes first")
("substitute, two invalid narinfos"): New tests.
* doc/guix.texi (Substitutes): Explain the new behavior.
---
 doc/guix.texi               |  28 ++++++-
 guix/scripts/substitute.scm | 134 ++++++++++++++++++++-----------
 tests/substitute.scm        | 190 +++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 290 insertions(+), 62 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 781c5f04d..5b5a1bbf0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2141,6 +2141,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
@@ -2189,9 +2191,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's one exception though: if an unauthorized server provides
+substitutes that are equivalent to those provided by an authorized
+server, then the unauthorized server becomes eligible for downloads.
+For example, let's 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 592c49732..dd49cf15f 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 b1d0fe931..0ad624795 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 <at> karetnikov.org>
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo <at> 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:
-- 
2.14.1

Message #14 received at 28324 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: 28324 <at> debbugs.gnu.org
Subject: Re: [bug#28324] [PATCH 0/2] Allow substitute downloads from
 unauthorized servers when they are undistinguishable
Date: Sat, 02 Sep 2017 00:18:04 +0200

Ludovic Courtès <ludo <at> gnu.org> skribis:

>   1. Add optional service discovery support in ‘guix substitute’ and
>      service advertisement in ‘guix publish’ via Guile-Avahi.  Imagine
>      going to a GHM or FOSDEM and getting binaries from your neighbor’s
>      laptop.  I think that’d be pretty cool.  :-)

Speaking of which, I should say that all this greatly benefited from an
insightful discussion with Andreas and others at the GHM last week-end!

Ludo’.

Message #19 received at 28324-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: 28324-done <at> debbugs.gnu.org
Subject: Re: [bug#28324] [PATCH 0/2] Allow substitute downloads from
 unauthorized servers when they are undistinguishable
Date: Mon, 11 Sep 2017 12:00:00 +0200

Hello!

Ludovic Courtès <ludo <at> gnu.org> skribis:

> This patch allows substitutes to be downloaded from an unauthorized
> server (one whose public key is not in /etc/guix/acl), or from a server
> that does not even sign substitutes, *provided* that server advertises
> and serves the exact same content as one of the authorized servers.

I went ahead and pushed these two patches:

a9468b422 * substitute: Download from unauthorized sources that provide the right content.
218f6ecca * substitute: Make substitute URLs a SRFI-39 parameter.

Commit 21c2757f27061cd6647cb00797b1c6c85f3325e8 updates the ‘guix’
package so that it contains this new feature.

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.