~ruther/guix-local

41c45e78632978ab64dd7df50765c6adf443a249 — Ludovic Courtès 11 years ago fc1ee09
store: Add preliminary support for client-supplied substitute URLs.

* guix/store.scm (set-build-options): Rename #:binary-caches to
  #:substitute-urls.  Actually pass it in 'pairs' under the
  "substitute-urls" key.
* guix/scripts/substitute-binary.scm (%cache-url): Add comment for
  "untrusted-substitute-urls".
2 files changed, 12 insertions(+), 7 deletions(-)

M guix/scripts/substitute-binary.scm
M guix/store.scm
M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +6 -1
@@ 631,7 631,12 @@ found."
  (assoc-ref (daemon-options) option))

(define %cache-url
  (match (and=> (find-daemon-option "substitute-urls")
  (match (and=> (string-append
                 ;; TODO: Uncomment the following lines when multiple
                 ;; substitute sources are supported.
                 ;; (find-daemon-option "untrusted-substitute-urls") ;client
                 ;; " "
                 (find-daemon-option "substitute-urls"))          ;admin
                string-tokenize)
    ((url)
     url)

M guix/store.scm => guix/store.scm +6 -6
@@ 459,7 459,7 @@ encoding conversion errors."
                            (print-build-trace #t)
                            (build-cores (current-processor-count))
                            (use-substitutes? #t)
                            (binary-caches '())) ; client "untrusted" cache URLs
                            (substitute-urls '())) ; client "untrusted" cache URLs
  ;; Must be called after `open-connection'.

  (define socket


@@ 484,11 484,11 @@ encoding conversion errors."
    (when (>= (nix-server-minor-version server) 10)
      (send (boolean use-substitutes?)))
    (when (>= (nix-server-minor-version server) 12)
      (let ((pairs (if timeout
                       `(("build-timeout" . ,(number->string timeout))
                         ,@binary-caches)
                       binary-caches)))
        (send (string-pairs pairs))))
      (let ((pairs `(,@(if timeout
                           `(("build-timeout" . ,(number->string timeout)))
                           '())
                     ("substitute-urls" . ,(string-join substitute-urls)))))
        (send (string-pairs (pk 'pairs pairs)))))
    (let loop ((done? (process-stderr server)))
      (or done? (process-stderr server)))))