From 8b92ebac4fa13a2a89f279b249be152051f31d94 Mon Sep 17 00:00:00 2001 From: Carlo Zancanaro 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 ()[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 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 ) that needs -to be unloaded, and the subset of TARGET (a list of ) that -need to be restarted to complete their upgrade." + "Return three values: (a) the subset of LIVE (a list of ) that +needs to be unloaded, (b) the subset of TARGET (a list of ) +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 . - (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