Subject: [bug#33508] [PATCH] gnu: Add ability to restart services on system reconfigure

From: Carlo Zancanaro <[email-masked]>
Date: Mon, 26 Nov 2018 22:41:01 +1100

Hey Guix!

A few months ago I mentioned the idea of adding the ability to 
have services automatically restarted when running "guix system 
reconfigure". These patches are a start on making that happen. 
They're incomplete (in particular, documentation is missing), but 
I'm offering them up for comment.

The broad idea is to add a new field to our guix shepherd 
services: restart-strategy. There are three valid values:

- always: this service is always safe to restart when running 
  reconfigure
 
- manual: this service may not be safe to restart when running 
  reconfigure - a message will be printed telling the user to 
  restart the service manually, or they can provide the 
  --restart-services flag to reconfigure to automatically restart 
  them

- never: this service is never safe to restart when running 
  reconfigure (eg. udev)

I have added the flag to the guix daemon's shepherd service to 
show how it works. I tested this by changing my substitute servers 
in config.scm, and after running "reconfigure" I saw my updated 
substitute servers in ps without having to run "sudo herd restart 
guix-daemon".

If nobody has any feedback in the next few days then I'll update 
the manual and send through another patch.

Carlo

>From 8b92ebac4fa13a2a89f279b249be152051f31d94 Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <[email-masked]>
Date: Mon, 26 Nov 2018 22:38:08 +1100
Subject: [PATCH 1/3] gnu: Add ability to restart services on system
 reconfigure

* gnu/services/herd.scm (restart-service): New procedure.
* gnu/services/shepherd.scm (<shepherd-service>)[restart-strategy]: New
  field.
  (shepherd-service-upgrade): Return lists of services to automatically and
  manually restart.
* guix/scripts/system.scm (call-with-service-upgrade-info): Pass through
  services to be automatically and manually restarted.
  (upgrade-shepherd-services): Automatically restart services that should be
  automatically restarted, and print a message about manually restarting
  services that should be manually restarted.
---
 gnu/services/herd.scm     |  5 +++++
 gnu/services/shepherd.scm | 35 ++++++++++++++++++++++--------
 guix/scripts/system.scm   | 45 ++++++++++++++++++++++++---------------
 3 files changed, 59 insertions(+), 26 deletions(-)

diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 8ff817759..c8d6eb04e 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -52,6 +52,7 @@
             load-services
             load-services/safe
             start-service
+            restart-service
             stop-service))
 
 ;;; Commentary:
@@ -256,6 +257,10 @@ when passed a service with an already-registered name."
   (with-shepherd-action name ('start) result
     result))
 
+(define (restart-service name)
+  (with-shepherd-action name ('restart) result
+    result))
+
 (define (stop-service name)
   (with-shepherd-action name ('stop) result
     result))
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 49d08cc30..0c80e44f2 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -159,7 +159,9 @@ DEFAULT is given, use it as the service's default value."
   (auto-start?   shepherd-service-auto-start?          ;Boolean
                  (default #t))
   (modules       shepherd-service-modules              ;list of module names
-                 (default %default-modules)))
+                 (default %default-modules))
+  (restart-strategy shepherd-service-restart-strategy
+                    (default 'manual)))
 
 (define-record-type* <shepherd-action>
   shepherd-action make-shepherd-action
@@ -344,9 +346,10 @@ symbols provided/required by a service."
                                     #t))))))
 
 (define (shepherd-service-upgrade live target)
-  "Return two values: the subset of LIVE (a list of <live-service>) that needs
-to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
-need to be restarted to complete their upgrade."
+  "Return three values: (a) the subset of LIVE (a list of <live-service>) that
+needs to be unloaded, (b) the subset of TARGET (a list of <shepherd-service>)
+that can be restarted automatically, and (c) the subset of TARGET that must be
+restarted manually."
   (define (essential? service)
     (memq (first (live-service-provision service))
           '(root shepherd)))
@@ -373,14 +376,28 @@ need to be restarted to complete their upgrade."
       (#f (every obsolete? (live-service-dependents service)))
       (_  #f)))
 
-  (define to-restart
-    ;; Restart services that are currently running.
-    (filter running? target))
-
   (define to-unload
     ;; Unload services that are no longer required.
     (remove essential? (filter obsolete? live)))
 
-  (values to-unload to-restart))
+  (define to-automatically-restart
+    ;; Automatically restart services that are currently running and can
+    ;; always be restarted.
+    (filter (lambda (service)
+              (and (running? service)
+                   (eq? (shepherd-service-restart-strategy service)
+                        'always)))
+            target))
+
+  (define to-manually-restart
+    ;; Manually restart services that are currently running and must be
+    ;; manually restarted.
+    (filter (lambda (service)
+              (and (running? service)
+                   (eq? (shepherd-service-restart-strategy service)
+                        'manual)))
+            target))
+
+  (values to-unload to-automatically-restart to-manually-restart))
 
 ;;; shepherd.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d92ec7d5a..6f14b1395 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -322,11 +322,12 @@ names of services to load (upgrade), and the list of names of services to
 unload."
   (match (current-services)
     ((services ...)
-     (let-values (((to-unload to-restart)
+     (let-values (((to-unload to-automatically-restart to-manually-restart)
                    (shepherd-service-upgrade services new-services)))
-       (mproc to-restart
-              (map (compose first live-service-provision)
-                   to-unload))))
+       (mproc (map (compose first live-service-provision)
+                   to-unload)
+              to-automatically-restart
+              to-manually-restart)))
     (#f
      (with-monad %store-monad
        (warning (G_ "failed to obtain list of shepherd services~%"))
@@ -347,7 +348,7 @@ bring the system down."
   ;; Arrange to simply emit a warning if the service upgrade fails.
   (with-shepherd-error-handling
    (call-with-service-upgrade-info new-services
-     (lambda (to-restart to-unload)
+     (lambda (to-unload to-automatically-restart to-manually-restart)
         (for-each (lambda (unload)
                     (info (G_ "unloading service '~a'...~%") unload)
                     (unload-service unload))
@@ -355,27 +356,37 @@ bring the system down."
 
         (with-monad %store-monad
           (munless (null? new-services)
-            (let ((new-service-names  (map shepherd-service-canonical-name new-services))
-                  (to-restart-names   (map shepherd-service-canonical-name to-restart))
-                  (to-start           (filter shepherd-service-auto-start? new-services)))
-              (info (G_ "loading new services:~{ ~a~}...~%") new-service-names)
-              (unless (null? to-restart-names)
-                ;; Listing TO-RESTART-NAMES in the message below wouldn't help
-                ;; because many essential services cannot be meaningfully
-                ;; restarted.  See <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22039#30>.
-                (format #t (G_ "To complete the upgrade, run 'herd restart SERVICE' to stop,
-upgrade, and restart each service that was not automatically restarted.\n")))
+            (let ((new-service-names              (map shepherd-service-canonical-name new-services))
+                  (to-start-names                 (map shepherd-service-canonical-name (filter shepherd-service-auto-start? new-services)))
+                  (to-automatically-restart-names (map shepherd-service-canonical-name to-automatically-restart))
+                  (to-manually-restart-names      (map shepherd-service-canonical-name to-manually-restart)))
+              (set! to-start-names
+                (remove (lambda (name)
+                          (or (member name to-automatically-restart-names)
+                              (member name to-manually-restart-names)))
+                        to-start-names))
+
               (mlet %store-monad ((files (mapm %store-monad
                                                (compose lower-object
                                                         shepherd-service-file)
                                                new-services)))
+                (for-each restart-service to-automatically-restart-names)
+
                 ;; Here we assume that FILES are exactly those that were computed
                 ;; as part of the derivation that built OS, which is normally the
                 ;; case.
+                (info (G_ "loading new services:~{ ~a~}~%") new-service-names)
                 (load-services/safe (map derivation->output-path files))
-
+                (info (G_ "starting services:~{ ~a~}~%") to-start-names)
                 (for-each start-service
-                          (map shepherd-service-canonical-name to-start))
+                          to-start-names)
+                (info (G_ "restarting services:~{ ~a~}~%") to-automatically-restart-names)
+                (for-each restart-service
+                          to-automatically-restart-names)
+
+                (unless (null? to-manually-restart-names)
+                  (format #t (G_ "To complete the upgrade, the following services need to be manually restarted:~{ ~a~}~%")
+                          to-manually-restart-names))
                 (return #t)))))))))
 
 (define* (switch-to-system os
-- 
2.19.1

>From 3fdef27c8f11b6a0f013afa9b6e619659ce78dec Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <[email-masked]>
Date: Mon, 26 Nov 2018 22:38:18 +1100
Subject: [PATCH 2/3] system: Add --restart-services flag for reconfigure

* guix/scripts/system.scm (upgrade-shepherd-services): Add parameter to
  automatically restart services marked as needing manual restart.
  (switch-to-system): Pass through restart-services? flag.
  (perform-action): Pass through restart-services? flag.
  (%options): Add --restart-services flag.
  (%default-options): Add #f as default value for --restart-services flag.
  (process-action): Pass through restart-services? flag.
---
 guix/scripts/system.scm | 24 +++++++++++++++++-------
 1 file changed, 17 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 6f14b1395..bf632c534 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -333,7 +333,7 @@ unload."
        (warning (G_ "failed to obtain list of shepherd services~%"))
        (return #f)))))
 
-(define (upgrade-shepherd-services os)
+(define (upgrade-shepherd-services os restart-services?)
   "Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new
 services specified in OS and not currently running.
 
@@ -360,6 +360,10 @@ bring the system down."
                   (to-start-names                 (map shepherd-service-canonical-name (filter shepherd-service-auto-start? new-services)))
                   (to-automatically-restart-names (map shepherd-service-canonical-name to-automatically-restart))
                   (to-manually-restart-names      (map shepherd-service-canonical-name to-manually-restart)))
+              (when restart-services?
+                (set! to-automatically-restart-names (append to-automatically-restart-names
+                                                             to-manually-restart-names))
+                (set! to-manually-restart-names '()))
               (set! to-start-names
                 (remove (lambda (name)
                           (or (member name to-automatically-restart-names)
@@ -389,7 +393,7 @@ bring the system down."
                           to-manually-restart-names))
                 (return #t)))))))))
 
-(define* (switch-to-system os
+(define* (switch-to-system os restart-services?
                            #:optional (profile %system-profile))
   "Make a new generation of PROFILE pointing to the directory of OS, switch to
 it atomically, and then run OS's activation script."
@@ -417,7 +421,7 @@ it atomically, and then run OS's activation script."
         (primitive-load (derivation->output-path script))))
 
       ;; Finally, try to update system services.
-      (upgrade-shepherd-services os))))
+      (upgrade-shepherd-services os restart-services?))))
 
 (define-syntax-rule (unless-file-not-found exp)
   (catch 'system-error
@@ -825,7 +829,8 @@ and TARGET arguments."
                          use-substitutes? bootloader-target target
                          image-size file-system-type full-boot?
                          (mappings '())
-                         (gc-root #f))
+                         (gc-root #f)
+                         (restart-services? #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
 bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
 target root directory; IMAGE-SIZE is the size of the image to be built, for
@@ -907,7 +912,7 @@ static checks."
           (case action
             ((reconfigure)
              (mbegin %store-monad
-               (switch-to-system os)
+               (switch-to-system os restart-services?)
                (mwhen install-bootloader?
                  (install-bootloader bootloader-script
                                      #:bootcfg bootcfg
@@ -1090,6 +1095,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '(#\r "root") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'gc-root arg result)))
+         (option '("restart-services") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'restart-services? #t result)))
          %standard-build-options))
 
 (define %default-options
@@ -1104,7 +1112,8 @@ Some ACTIONS support additional ARGS.\n"))
     (verbosity . 0)
     (file-system-type . "ext4")
     (image-size . guess)
-    (install-bootloader? . #t)))
+    (install-bootloader? . #t)
+    (restart-services? . #f)))
 
 
 ;;;
@@ -1177,7 +1186,8 @@ resulting from command-line parsing."
                              #:install-bootloader? bootloader?
                              #:target target
                              #:bootloader-target bootloader-target
-                             #:gc-root (assoc-ref opts 'gc-root)))))
+                             #:gc-root (assoc-ref opts 'gc-root)
+                             #:restart-services? (assoc-ref opts 'restart-services?)))))
         #:system system))
     (warn-about-disk-space)))
 
-- 
2.19.1

>From 099a8e2e6e28b38816ed1ba895c407f1d9efe62e Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <[email-masked]>
Date: Mon, 26 Nov 2018 22:38:26 +1100
Subject: [PATCH 3/3] services: Always restart guix daemon

* gnu/services/base.scm (guix-shepherd-service): Add restart-strategy of
  'always.
---
 gnu/services/base.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 228d3c592..7e0fdcb3e 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1573,6 +1573,7 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
            (documentation "Run the Guix daemon.")
            (provision '(guix-daemon))
            (requirement '(user-processes))
+           (restart-strategy 'always)
            (modules '((srfi srfi-1)))
            (start
             #~(make-forkexec-constructor
-- 
2.19.1