From 9176607ec4cffb85b46e71af49bbc8a330aec5c3 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 9 Oct 2014 13:25:41 +0200
Subject: daemon: Add '--substitute-urls' option.

* nix/nix-daemon/guix-daemon.cc (GUIX_OPT_SUBSTITUTE_URLS): New macro.
  (GUIX_OPT_NO_BUILD_HOOK, GUIX_OPT_GC_KEEP_OUTPUTS,
  GUIX_OPT_GC_KEEP_DERIVATIONS): Renumber.
  (options): Add '--substitute-urls'.
  (parse_opt): Honor it.
  (main): Add 'settings.set' call for the default "substitute-urls"
  value.
* guix/scripts/substitute-binary.scm (daemon-options,
  find-daemon-option): New procedures.
  (%cache-url): Define based on the "substitute-urls" daemon option.
* doc/guix.texi (Invoking guix-daemon): Document '--substitute-urls'.
  (Substitutes): Mention it.
---
 guix/scripts/substitute-binary.scm | 44 ++++++++++++++++++++++++++++++++++----
 1 file changed, 40 insertions(+), 4 deletions(-)

(limited to 'guix')

diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index ec7596efb6..7a286426a1 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -528,10 +528,6 @@ (define (read! bv start count)
                 (_ "(Please consider upgrading Guile to get proper progress report.)~%"))
         port)))
 
-(define %cache-url
-  (or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
-      "http://hydra.gnu.org"))
-
 (define-syntax with-networking
   (syntax-rules ()
     "Catch DNS lookup errors and gracefully exit."
@@ -604,6 +600,46 @@ (define (singleton? acl)
       (warning (_ "ACL for archive imports seems to be uninitialized, \
 substitutes may be unavailable\n")))))
 
+(define (daemon-options)
+  "Return a list of name/value pairs denoting build daemon options."
+  (define %not-newline
+    (char-set-complement (char-set #\newline)))
+
+  (match (getenv "_NIX_OPTIONS")
+    (#f                           ;should not happen when called by the daemon
+     '())
+    (newline-separated
+     ;; Here we get something of the form "OPTION1=VALUE1\nOPTION2=VALUE2\n".
+     (filter-map (lambda (option=value)
+                   (match (string-index option=value #\=)
+                     (#f                          ;invalid option setting
+                      #f)
+                     (equal-sign
+                      (cons (string-take option=value equal-sign)
+                            (string-drop option=value (+ 1 equal-sign))))))
+                 (string-tokenize newline-separated %not-newline)))))
+
+(define (find-daemon-option option)
+  "Return the value of build daemon option OPTION, or #f if it could not be
+found."
+  (assoc-ref (daemon-options) option))
+
+(define %cache-url
+  (or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+      (match (and=> (find-daemon-option "substitute-urls")
+                    string-tokenize)
+        ((url)
+         url)
+        ((head tail ..1)
+         ;; Currently we don't handle multiple substitute URLs.
+         (warning (_ "these substitute URLs will not be used:~{ ~a~}~%")
+                  tail)
+         head)
+        (#f
+         ;; This can only happen when this script is not invoked by the
+         ;; daemon.
+         "http://hydra.gnu.org"))))
+
 (define (guix-substitute-binary . args)
   "Implement the build daemon's substituter protocol."
   (mkdir-p %narinfo-cache-directory)
-- 
cgit v1.2.3