[shepherd] 03/03: herd: Display info about pending replacements.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit a32107ae5a7427d528d984f57f9ef11b66a6abb7
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Apr 1 23:13:08 2024 +0200

    herd: Display info about pending replacements.
    
    * modules/shepherd/scripts/herd.scm (<live-service>)[pending-replacement?]:
    New field.
    (sexp->live-service): Initialize it.
    (display-service-status): Display info about pending replacements.
    (display-status-summary)[display-services]: Highlight when
    ‘live-service-pending-replacement?’ is true.
    * modules/shepherd/scripts/herd.scm (display-status-summary):
---
 modules/shepherd/scripts/herd.scm | 19 ++++++++++++++-----
 tests/replacement.sh              |  6 +++++-
 2 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 7c13568..a0acaff 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -47,7 +47,8 @@
                 enabled? status running
                 status-changes last-respawns startup-failures
                 exit-statuses
-                recent-messages log-file)
+                recent-messages log-file
+                pending-replacement?)
   live-service?
   (provision        live-service-provision)       ;list of symbols
   (requirement      live-service-requirement)     ;list of symbols
@@ -63,7 +64,8 @@
   (startup-failures live-service-startup-failures) ;list of integers
   (exit-statuses    live-service-process-exit-statuses) ;integers/timestamps
   (recent-messages  live-service-recent-messages)  ;list of strings
-  (log-file         live-service-log-file))        ;#f | string
+  (log-file         live-service-log-file)         ;#f | string
+  (pending-replacement? live-service-pending-replacement?))     ;Boolean
 
 (define (live-service-canonical-name service)
   "Return the 'canonical name' of @var{service}."
@@ -117,7 +119,7 @@ into a @code{live-service} record."
                              status-changes last-respawns startup-failures
                              exit-statuses
                              recent-messages log-file
-                             one-shot? transient?)
+                             one-shot? transient? pending-replacement?)
        (live-service provides requires one-shot?
                      transient? respawn?
 
@@ -129,7 +131,8 @@ into a @code{live-service} record."
                      (or startup-failures '())
                      (or exit-statuses '())
                      (or recent-messages '())
-                     log-file)))))
+                     log-file
+                     pending-replacement?)))))
 
 (define (highlight-if-long-transient-status service)
   "Return a procedure to highlight @var{service} if it's been stuck in a
@@ -152,7 +155,9 @@ transient status for too long."
       (display header)
       (for-each (lambda (service)
                   (define highlight
-                    (highlight-if-long-transient-status service))
+                    (if (live-service-pending-replacement? service)
+                        highlight
+                        (highlight-if-long-transient-status service)))
 
                   (format #t " ~a ~a~%" bullet
                           (highlight
@@ -450,6 +455,10 @@ calendar event."
         (format #t (highlight (l10n "  It is disabled.~%")))))
   (format #t (l10n "  Provides ~a.~%") (live-service-provision service))
   (format #t (l10n "  Requires ~a.~%") (live-service-requirement service))
+  (when (live-service-pending-replacement? service)
+    (format #t (highlight/warn (l10n "  Replacement pending (restart \
+to upgrade).~%"))))
+
   (if (live-service-respawn? service)
       (format #t (l10n "  Will be respawned.~%"))
       (format #t (l10n "  Will not be respawned.~%")))
diff --git a/tests/replacement.sh b/tests/replacement.sh
index 1c89e3e..6b8cf9c 100644
--- a/tests/replacement.sh
+++ b/tests/replacement.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Ensure replacing services works properly
-# Copyright © 2014, 2016, 2023 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2016, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
 #
 # This file is part of the GNU Shepherd.
@@ -61,6 +61,8 @@ $herd start test
 $herd say-hello test
 test -f "$stamp"
 
+$herd status test | grep -v "Replacement pending"
+
 cat > "$rconf"<<EOF
 (register-services
  (list (service
@@ -79,6 +81,8 @@ EOF
 
 $herd load root "$rconf"
 
+$herd status test | grep "Replacement pending"
+
 $herd say-hello test
 test "`cat $stamp`" = "Hello"