From 25d631b33b84f1f48bc06a192c46eb3170e29b97 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. (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 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 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 . - (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