[shepherd] 06/06: herd: ‘status’ displays recently-logged messages.

[Ludovic Courtès]

civodul pushed a commit to branch wip-logging
in repository shepherd.

commit 627ad756a84c9f49ce5254bd99ffabd8611f2b9a
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Dec 4 23:33:30 2023 +0100

    herd: ‘status’ displays recently-logged messages.
    
    * modules/shepherd/support.scm (at-most): Make public.
    * modules/shepherd/scripts/herd.scm (<live-service>)[recent-messages]:
    New field.
    (sexp->live-service): Decode it.
    (%default-log-history-size): New variable.
    (display-service-status): Display recent messages.
    * tests/logging.sh: Test it.
---
 modules/shepherd/scripts/herd.scm | 33 ++++++++++++++++++++++++++++-----
 modules/shepherd/support.scm      |  1 +
 tests/logging.sh                  | 11 +++++++++++
 3 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 6f298e5..723136b 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -38,7 +38,8 @@
 (define-record-type <live-service>
   (live-service provision requirement one-shot? transient? respawn?
                 enabled? status running
-                status-changes last-respawns startup-failures)
+                status-changes last-respawns startup-failures
+                recent-messages)
   live-service?
   (provision        live-service-provision)       ;list of symbols
   (requirement      live-service-requirement)     ;list of symbols
@@ -51,7 +52,8 @@
   (running          live-service-running-value)    ;#f | object
   (status-changes   live-service-status-changes)   ;symbol/integer pairs
   (last-respawns    live-service-last-respawns)    ;list of integers
-  (startup-failures live-service-startup-failures)) ;list of integers
+  (startup-failures live-service-startup-failures) ;list of integers
+  (recent-messages  live-service-recent-messages)) ;list of strings
 
 (define (live-service-canonical-name service)
   "Return the 'canonical name' of @var{service}."
@@ -97,6 +99,7 @@ into a @code{live-service} record."
     (('service ('version 0 _ ...) properties ...)
      (alist-let* properties (provides requires status running respawn? enabled?
                              status-changes last-respawns startup-failures
+                             recent-messages
                              one-shot? transient?)
        (live-service provides requires one-shot?
                      transient? respawn?
@@ -106,7 +109,8 @@ into a @code{live-service} record."
                      running
                      (or status-changes '())
                      (or last-respawns '())
-                     (or startup-failures '()))))))
+                     (or startup-failures '())
+                     (or recent-messages '()))))))
 
 (define (highlight-if-long-transient-status service)
   "Return a procedure to highlight @var{service} if it's been stuck in a
@@ -216,7 +220,13 @@ transient status for too long."
   ;; relative date string like "2 hours ago".
   (format #f (l10n "~a (~a)") absolute relative))
 
-(define (display-service-status service)
+(define %default-log-history-size
+  ;; Number of log lines displayed by default.
+  10)
+
+(define* (display-service-status service
+                                 #:key
+                                 (log-history-size %default-log-history-size))
   "Display the status of SERVICE, an sexp."
   (format #t (highlight (l10n "Status of ~a:~%"))
           (live-service-canonical-name service))
@@ -285,7 +295,20 @@ transient status for too long."
       ((time _ ...)
        (format #t (highlight/error (l10n "  Failed to start at ~a.~%"))
                (time->string time)))
-      (_ #t))))
+      (_ #t)))
+
+  (match (live-service-recent-messages service)
+    (() #t)
+    (messages
+     (newline)
+     (format #t (highlight (l10n "Recent messages:~%")))
+     (for-each (match-lambda
+                 ((time . line)
+                  (format #t "  ~a~a~%"
+                          (strftime default-logfile-date-format
+                                    (localtime time))
+                          line)))
+               (at-most log-history-size messages)))))
 
 (define (display-event-log services)
   "Display status changes of @var{services} as a chronologically-sorted log."
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index 2b5f698..2fc0f40 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -36,6 +36,7 @@
             ring-buffer-limit
             ring-buffer-insert
             ring-buffer->list
+            at-most
 
             buffering
             catch-system-error
diff --git a/tests/logging.sh b/tests/logging.sh
index 961e5b5..742bfa8 100644
--- a/tests/logging.sh
+++ b/tests/logging.sh
@@ -86,6 +86,12 @@ do
     grep -E '^2[0-9]{3}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2} 
'"$message" "$service_log"
 done
 
+$herd status test-file-logging | \
+    grep -E '^  2[0-9]{3}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2} 
STARTING'
+$herd status test-file-logging | \
+    grep -E '^  2[0-9]{3}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2} STARTED'
+
+
 # Return the file descriptor corresponding to the given file.
 find_file_descriptor ()
 {
@@ -113,4 +119,9 @@ do
     grep -E '^2[0-9]{3}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2} 
.*'"$message" "$log"
 done
 
+$herd status test-builtin-logging | \
+    grep -E '^  2[0-9]{3}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2} 
STARTING'
+$herd status test-builtin-logging | \
+    grep -E '^  2[0-9]{3}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2} STARTED'
+
 $herd stop root