[shepherd] 01/08: service: Add ‘service-log-file’.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 17848120a9e7bca6aa63e7d9f6c0a81446d61644
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Feb 17 15:05:27 2024 +0100

    service: Add ‘service-log-file’.
    
    * modules/shepherd/service.scm (service-controller): Handle ‘log-file’
    messages.
    (service-log-file): New procedure.
    (service->sexp): Add ‘log-file’ entry.
    (%service-file-logger): Handle ‘file’ messages.
    (service-builtin-logger): Likewise.
    * tests/status-sexp.sh: Add ‘log-file’ entry to sexps.
    * doc/shepherd.texi (Interacting with Services): Document 
‘service-log-file’.
---
 doc/shepherd.texi            |  6 ++++++
 modules/shepherd/service.scm | 22 ++++++++++++++++++++--
 tests/status-sexp.sh         | 14 +++++++++-----
 3 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 795de9b..e3fb3e6 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -1028,6 +1028,12 @@ is a timestamp/string pair where the timestamp is the 
number of seconds
 since January 1st, 1970 (an integer).
 @end deffn
 
+@deffn {Procedure} service-log-file @var{service}
+Return the file where messages by @var{service} are logged, or @code{#f}
+if there is no such file, for instance because @var{service}'s output is
+logged by some mechanism not under shepherd's control.
+@end deffn
+
 @xref{Service Internals}, if you're curious about the nitty-gritty
 details!
 
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 678ca41..12700b8 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1,5 +1,5 @@
 ;; service.scm -- Representation of services.
-;; Copyright (C) 2013-2023 Ludovic Courtès <ludo@gnu.org>
+;; Copyright (C) 2013-2024 Ludovic Courtès <ludo@gnu.org>
 ;; Copyright (C) 2002, 2003 Wolfgang Järling <wolfgang@pro-linux.de>
 ;; Copyright (C) 2014 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
 ;; Copyright (C) 2016 Alex Kost <alezost@gmail.com>
@@ -71,6 +71,7 @@
             service-status-changes
             service-replacement
             service-recent-messages
+            service-log-file
             service-action-list
             lookup-service-action
             service-defines-action?
@@ -706,6 +707,12 @@ denoting what the service provides."
            (put-message logger `(recent-messages ,reply))
            (put-message reply '()))
        (loop))
+      (('log-file reply)
+       ;; Likewise, forward to LOGGER if it exists.
+       (if logger
+           (put-message logger `(file ,reply))
+           (put-message reply #f))
+       (loop))
 
       ('terminate                                 ;no reply
        (if (eq? status 'stopped)
@@ -823,6 +830,10 @@ channel and wait for its reply."
   ;; Return the list of recent messages logged for @var{service}.
   (service-control-message 'recent-messages))
 
+(define service-log-file
+  ;; Return file where @var{service} logs messages, #f if there is none.
+  (service-control-message 'log-file))
+
 (define (enable-service service)
   "Enable @var{service}."
   (put-message (service-control service) 'enable))
@@ -1148,7 +1159,8 @@ clients."
             (transient? ,(transient-service? service))
             (respawn-limit ,(service-respawn-limit service))
             (respawn-delay ,(service-respawn-delay service))
-            (recent-messages ,(service-recent-messages service))))
+            (recent-messages ,(service-recent-messages service))
+            (log-file ,(service-log-file service))))
 
 
 ;;;
@@ -1523,6 +1535,9 @@ not exist."
               (('recent-messages reply)
                (put-message reply (ring-buffer->list messages))
                (loop messages service))
+              (('file reply)
+               (put-message reply file)
+               (loop messages service))
               (line
                (let* ((now (current-time))
                       (prefix (strftime default-logfile-date-format
@@ -1603,6 +1618,9 @@ to @var{history-size} lines in memory."
         (('recent-messages reply)
          (put-message reply (ring-buffer->list messages))
          (loop pid messages service))
+        (('file reply)
+         (put-message reply #f)                   ;not logged to a file
+         (loop pid messages service))
         (line
          (let* ((pid (or pid
                          (and service
diff --git a/tests/status-sexp.sh b/tests/status-sexp.sh
index 22f8136..4fdc211 100644
--- a/tests/status-sexp.sh
+++ b/tests/status-sexp.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Test status sexps.
-# Copyright © 2016, 2023 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2016, 2023, 2024 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -82,7 +82,8 @@ root_service_sexp="
       (transient? #f)
       (respawn-limit (5 . 7))
       (respawn-delay 0.1)
-      (recent-messages ()))"
+      (recent-messages ())
+      (log-file #f))"
 
 # Define a helper procedure that resets timestamps in the 'status-changes'
 # property to make it easier to compare them.
@@ -123,7 +124,8 @@ $define_reset_timestamps
                (status running)
                (one-shot? #f) (transient? #f)
                (respawn-limit (5 . 7)) (respawn-delay 1)
-              (recent-messages ()))
+              (recent-messages ())
+              (log-file #f))
              (service (version 0)
                (provides (bar)) (requires (foo))
                (respawn? #f) (docstring \"Bar!\")
@@ -134,7 +136,8 @@ $define_reset_timestamps
                (status stopped)
                (one-shot? #f) (transient? #f)
                (respawn-limit (5 . 7)) (respawn-delay 1)
-               (recent-messages ())))))))
+               (recent-messages ())
+              (log-file #f)))))))
 "
 
 # The 'start' command should return the service sexp on success.
@@ -163,7 +166,8 @@ $define_reset_timestamps
                (status running)
                (one-shot? #f) (transient? #f)
                (respawn-limit (5 . 7)) (respawn-delay 1)
-              (recent-messages ()))))))
+              (recent-messages ())
+              (log-file #f))))))
 "
 
 # Make sure we get an 'error' sexp when querying a nonexistent service.