From e461d3b750080b03f3deea0b44b99c2fda9767ab Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Fri, 4 Dec 2020 09:43:17 +0100
Subject: [PATCH] service: Add shepherd discover action.

* gnu/services/base.scm (shepherd-discover-action): New procedure,
(guix-shepherd-service)[<actions>]: add it,
[<start>]: honor it.
* doc/guix.texi (Invoking guix-daemon): Document it.
---
 doc/guix.texi         |  8 ++++++++
 gnu/services/base.scm | 32 ++++++++++++++++++++++++++++----
 2 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a4386adf42..a21c4d614e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1606,6 +1606,14 @@ Servers may serve substitute over HTTP, unencrypted, so anyone on the
 LAN can see what software you’re installing.
 @end enumerate
 
+It is also possible to enable or disable substitute server discovery at
+run-time by running:
+
+@example
+herd discover guix-daemon on
+herd discover guix-daemon off
+@end example
+
 @item --disable-deduplication
 @cindex deduplication
 Disable automatic file ``deduplication'' in the store.
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d0d88e18a6..709d011f53 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1568,6 +1568,27 @@ proxy of 'guix-daemon'...~%")
                     (environ environment)
                     #t)))))
 
+(define shepherd-discover-action
+  ;; Shepherd action to enable or disable substitute servers discovery.
+  (shepherd-action
+   (name 'discover)
+   (documentation
+    "Enable or disable substitute servers discovery and restart the
+'guix-daemon'.")
+   (procedure #~(lambda* (_ status)
+                  (let ((environment (environ)))
+                    (if (and status
+                             (string=? status "on"))
+                        (begin
+                          (format #t "enable substitute servers discovery~%")
+                          (setenv "discover" "on"))
+                        (begin
+                          (format #t "disable substitute servers discovery~%")
+                          (unsetenv "discover")))
+                    (action 'guix-daemon 'restart)
+                    (environ environment)
+                    #t)))))
+
 (define (guix-shepherd-service config)
   "Return a <shepherd-service> for the Guix daemon service with CONFIG."
   (match-record config <guix-configuration>
@@ -1579,7 +1600,8 @@ proxy of 'guix-daemon'...~%")
            (documentation "Run the Guix daemon.")
            (provision '(guix-daemon))
            (requirement '(user-processes))
-           (actions (list shepherd-set-http-proxy-action))
+           (actions (list shepherd-set-http-proxy-action
+                          shepherd-discover-action))
            (modules '((srfi srfi-1)
                       (ice-9 match)
                       (gnu build shepherd)))
@@ -1594,6 +1616,9 @@ proxy of 'guix-daemon'...~%")
                     ;; the 'set-http-proxy' action.
                     (or (getenv "http_proxy") #$http-proxy))
 
+                  (define discover?
+                    (or (getenv "discover") #$discover?))
+
                   ;; Start the guix-daemon from a container, when supported,
                   ;; to solve an installation issue. See the comment below for
                   ;; more details.
@@ -1608,9 +1633,8 @@ proxy of 'guix-daemon'...~%")
                           #$@(if use-substitutes?
                                  '()
                                  '("--no-substitutes"))
-                          #$@(if discover?
-                                 '("--discover=yes")
-                                 '())
+                          (string-append "--discover="
+                                         (if discover? "yes" "no"))
                           "--substitute-urls" #$(string-join substitute-urls)
                           #$@extra-options
 
-- 
2.20.1