TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

store: Add preliminary support for client-supplied substitute URLs.

Browse source 
* 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".
This commit is contained in:
Ludovic Courtès 2015-03-18 14:39:53 +01:00
parent fc1ee09578
commit 41c45e7863
2 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
guix/scripts/substitute-binary.scm
View file

@ -631,7 +631,12 @@ (define (find-daemon-option option)
(assoc-ref (daemon-options) option)) (assoc-ref (daemon-options) option))
(define %cache-url (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) string-tokenize)
((url) ((url)
url) url)

12
guix/store.scm
View file

@ -459,7 +459,7 @@ (define* (set-build-options server
(print-build-trace #t) (print-build-trace #t)
(build-cores (current-processor-count)) (build-cores (current-processor-count))
(use-substitutes? #t) (use-substitutes? #t)
(binary-caches '())) ; client "untrusted" cache URLs (substitute-urls '())) ; client "untrusted" cache URLs
;; Must be called after `open-connection'. ;; Must be called after `open-connection'.
(define socket (define socket
@ -484,11 +484,11 @@ (define socket
(when (>= (nix-server-minor-version server) 10) (when (>= (nix-server-minor-version server) 10)
(send (boolean use-substitutes?))) (send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12) (when (>= (nix-server-minor-version server) 12)
(let ((pairs (if timeout (let ((pairs `(,@(if timeout
`(("build-timeout" . ,(number->string timeout)) `(("build-timeout" . ,(number->string timeout)))
,@binary-caches) '())
binary-caches))) ("substitute-urls" . ,(string-join substitute-urls)))))
(send (string-pairs pairs)))) (send (string-pairs (pk 'pairs pairs)))))
(let loop ((done? (process-stderr server))) (let loop ((done? (process-stderr server)))
(or done? (process-stderr server))))) (or done? (process-stderr server)))))