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

[Clément Lassieur]

Hi Carlo,

Thank you for your modifications.  I like your patches better now :-)
But I prefer to let Ludovic comment on them, as I have seen an email
from him about Guix-daemon restart strategy.

Cheers!
Clément

Carlo Zancanaro <address@hidden> writes:

> Hey Clément,
>
> I'm still working through my thoughts on how all of this should 
> work. I feel like there are a few different use-cases that change 
> the trade-offs (eg. servers vs desktops, multi-user vs 
> single-user) and I don't know what the best defaults are, or the 
> most useful ways to vary that behaviour.
>
> I've attached my most recent version of my patches. I haven't had 
> a chance to test them (so they may have really dumb mistakes), but 
> they should implement the idea of restart-actions as procedures.
>
> On Fri, Nov 30 2018, Clément Lassieur wrote:
>> It could also detect whether you pass a symbol or a procedure. 
>> In most cases that would be a symbol which would allow static 
>> analysis.  But one could still customize it with a procedure.
>
> I don't like this way of having two different representations for 
> the same thing. In my current implementation there are three 
> procedures, {always,manually,never}-restart, which can be used 
> directly in the place of the old symbols (thus we can check for 
> those strategies with eq?).
>
> Carlo
>
> From 25d631b33b84f1f48bc06a192c46eb3170e29b97 Mon Sep 17 00:00:00 2001
> From: Carlo Zancanaro <address@hidden>
> 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.
>   (always-restart, manually-restart, never-restart): New procedures.
> * guix/scripts/system.scm (upgrade-shepherd-services): Automatically restart
>   services that should be automatically restarted, and print a message about
>   manually restarting services that should be manually restarted.
>
> Temporary commit
> ---
>  gnu/services/herd.scm     |  5 +++++
>  gnu/services/shepherd.scm | 25 ++++++++++++++++++++++++-
>  guix/scripts/system.scm   | 37 +++++++++++++++++++++++++------------
>  3 files changed, 54 insertions(+), 13 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..f7e690fb0 100644
> --- a/gnu/services/shepherd.scm
> +++ b/gnu/services/shepherd.scm
> @@ -44,12 +44,17 @@
>              shepherd-service-provision
>              shepherd-service-canonical-name
>              shepherd-service-requirement
> +            shepherd-service-restart-strategy
>              shepherd-service-respawn?
>              shepherd-service-start
>              shepherd-service-stop
>              shepherd-service-auto-start?
>              shepherd-service-modules
>  
> +            always-restart
> +            manually-restart
> +            never-restart
> +
>              shepherd-action
>              shepherd-action?
>              shepherd-action-name
> @@ -141,6 +146,22 @@ DEFAULT is given, use it as the service's default value."
>      (guix build utils)
>      (guix build syscalls)))
>  
> +(define (always-restart service)
> +  "Unconditionally restart SERVICE and return #f."
> +  (let ((name (shepherd-service-canonical-name service)))
> +    (info (G_ "restarting service: ~a~%") name)
> +    (restart-service name)
> +    #f))
> +
> +(define (manually-restart service)
> +  "Do not restart SERVICE, but return #t to indicate that the user should
> +restart it."
> +  #t)
> +
> +(define (never-restart service)
> +  "Do not restart SERVICE and return #f."
> +  #f)
> +
>  (define-record-type* <shepherd-service>
>    shepherd-service make-shepherd-service
>    shepherd-service?
> @@ -159,7 +180,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  ;procedure
> +                    (default manually-restart)))
>  
>  (define-record-type* <shepherd-action>
>    shepherd-action make-shepherd-action
> diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
> index d92ec7d5a..26e35fe99 100644
> --- a/guix/scripts/system.scm
> +++ b/guix/scripts/system.scm
> @@ -355,16 +355,14 @@ 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-restart-names  (map shepherd-service-canonical-name 
> to-restart))
> +                   (to-start-names    (map shepherd-service-canonical-name
> +                                           (filter (lambda (service)
> +                                                     (and 
> (shepherd-service-auto-start? service)
> +                                                          (not (member 
> service to-restart))))
> +                                                   new-services))))
> +
>                (mlet %store-monad ((files (mapm %store-monad
>                                                 (compose lower-object
>                                                          
> shepherd-service-file)
> @@ -372,10 +370,25 @@ upgrade, and restart each service that was not 
> automatically restarted.\n")))
>                  ;; 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))
>  
> -                (for-each start-service
> -                          (map shepherd-service-canonical-name to-start))
> +                (info (G_ "starting services:~{ ~a~}~%") to-start-names)
> +                (for-each (lambda (service-name)
> +                            (info (G_ "starting service: ~a~%") service-name)
> +                            (start-service service-name))
> +                          to-start-names)
> +
> +                (let* ((to-manually-restart (filter (lambda (service)
> +                                                      
> ((shepherd-service-restart-strategy service)
> +                                                       service))
> +                                                    to-restart))
> +                       (to-manually-restart-names (map 
> shepherd-service-canonical-name
> +                                                       to-manually-restart)))
> +                  (unless (null? to-manually-restart-names)
> +                    (info (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.2
>
> From 270a126c6efd498798bb9342a12c0f671df51b4c Mon Sep 17 00:00:00 2001
> From: Carlo Zancanaro <address@hidden>
> Date: Mon, 26 Nov 2018 22:38:18 +1100
> Subject: [PATCH 2/3] system: Add --restart-services flag for reconfigure
>
> * gnu/services/shepherd.scm (always-restart, manually-restart, never-restart):
>   Add restart-services? argument.
> * guix/scripts/system.scm (upgrade-shepherd-services): Add parameter to
>   automatically restart services marked as needing manual restart.
>   (switch-to-system, perform-action, process-action): Pass through
>   restart-services? flag.
>   (%options): Add --restart-services flag.
>   (%default-options): Add #f as default value for --restart-services flag.
> ---
>  gnu/services/shepherd.scm | 14 ++++++++------
>  guix/scripts/system.scm   | 23 +++++++++++++++--------
>  2 files changed, 23 insertions(+), 14 deletions(-)
>
> diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
> index f7e690fb0..638f6440c 100644
> --- a/gnu/services/shepherd.scm
> +++ b/gnu/services/shepherd.scm
> @@ -146,19 +146,21 @@ DEFAULT is given, use it as the service's default 
> value."
>      (guix build utils)
>      (guix build syscalls)))
>  
> -(define (always-restart service)
> +(define (always-restart service restart-services?)
>    "Unconditionally restart SERVICE and return #f."
>    (let ((name (shepherd-service-canonical-name service)))
>      (info (G_ "restarting service: ~a~%") name)
>      (restart-service name)
>      #f))
>  
> -(define (manually-restart service)
> -  "Do not restart SERVICE, but return #t to indicate that the user should
> -restart it."
> -  #t)
> +(define (manually-restart service restart-services?)
> +  "Restart SERVICE and return #f if RESTART-SERVICES? is true, otherwise 
> return #t to
> +indicate that the user should manually restart SERVICE."
> +  (if restart-services?
> +      (always-restart service #t)
> +      #t))
>  
> -(define (never-restart service)
> +(define (never-restart service restart-services?)
>    "Do not restart SERVICE and return #f."
>    #f)
>  
> diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
> index 26e35fe99..7c2699065 100644
> --- a/guix/scripts/system.scm
> +++ b/guix/scripts/system.scm
> @@ -332,7 +332,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.
>  
> @@ -381,7 +381,8 @@ bring the system down."
>  
>                  (let* ((to-manually-restart (filter (lambda (service)
>                                                        
> ((shepherd-service-restart-strategy service)
> -                                                       service))
> +                                                       service
> +                                                       restart-services?))
>                                                      to-restart))
>                         (to-manually-restart-names (map 
> shepherd-service-canonical-name
>                                                         to-manually-restart)))
> @@ -391,7 +392,7 @@ bring the system down."
>  
>                  (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."
> @@ -419,7 +420,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
> @@ -827,7 +828,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
> @@ -909,7 +911,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
> @@ -1092,6 +1094,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
> @@ -1106,7 +1111,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)))
>  
>
>  ;;;
> @@ -1179,7 +1185,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.2
>
> From 2077919dca604c94b09cf105c33987daa8c46304 Mon Sep 17 00:00:00 2001
> From: Carlo Zancanaro <address@hidden>
> 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-restart.
> ---
>  gnu/services/base.scm | 1 +
>  1 file changed, 1 insertion(+)
>
> diff --git a/gnu/services/base.scm b/gnu/services/base.scm
> index 228d3c592..37d60720d 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-restart)
>             (modules '((srfi srfi-1)))
>             (start
>              #~(make-forkexec-constructor