[shepherd] 02/08: system-log: Turn dispatcher into a proper logger.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit eb3c8ad8665bd24ee51528c6594c71162cd616eb
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Aug 7 22:44:47 2024 +0200

    system-log: Turn dispatcher into a proper logger.
    
    * modules/shepherd/service/system-log.scm (run-system-log): Do not relay
    'terminate message to DISPATCHER.
    (log-dispatcher): Serve the 'recent-messages, 'files, and 'rotate
    requests.  Remove argument of 'terminate message to match the logger
    protocol.
    (system-log-service): In #:start, call ‘register-service-logger’ for
    DISPATCHER.
    * tests/services/system-log.sh: Retry a few times when checking final
    file descriptor count.  Check the “Log files:” line in ‘herd status’.
---
 modules/shepherd/service/system-log.scm | 76 ++++++++++++++++++++-------------
 tests/services/system-log.sh            | 21 ++++++++-
 2 files changed, 66 insertions(+), 31 deletions(-)

diff --git a/modules/shepherd/service/system-log.scm 
b/modules/shepherd/service/system-log.scm
index 33e5755..097142c 100644
--- a/modules/shepherd/service/system-log.scm
+++ b/modules/shepherd/service/system-log.scm
@@ -216,9 +216,11 @@ and passing them to @var{dispatcher}."
          (line (put-message dispatcher (parse-system-log-message line))))
        (loop))
       (('terminate reply)
+       ;; Close all of PORTS.  DISPATCHER itself is registered as a logger and
+       ;; thus shut down separately, by the service itself.
        (local-output (l10n "Terminating system log service."))
        (for-each close-port ports)
-       (put-message dispatcher `(terminate ,reply))))))
+       (put-message reply #t)))))
 
 (define %heartbeat-message
   ;; Message logged when nothing was logged for a while.
@@ -298,15 +300,26 @@ in message destination procedure: "))
                      #t
                      ports)
          (loop ports))
-        (('terminate reply)
+        (('recent-messages reply)
+         (put-message reply '())                  ;TODO: implement it
+         (loop ports))
+        (('files reply)
+         (put-message reply (vhash-fold (lambda (file _ lst)
+                                          (cons file lst))
+                                        '()
+                                        ports))
+         (loop ports))
+        (('rotate requested-file rotated-file reply)
+         (put-message reply #f)                   ;TODO: implement it
+         (loop ports))
+        ('terminate
          (local-output (l10n "Closing ~a system log ports.")
                        (vlist-length ports))
          (vhash-fold (lambda (file port _)
                        (close-port port)
                        #t)
                      #t
-                     ports)
-         (put-message reply #t))))))
+                     ports))))))
 
 (define* (spawn-log-dispatcher message-destination #:key max-silent-time)
   "Spawn the log dispatcher, responsible for writing system log messages to
@@ -391,29 +404,32 @@ it also reads messages from @code{#:kernel-log-file}, 
which defaults to
 Log messages are passed to @var{message-destination}, a one-argument procedure
 that must return the list of files to write it to.  Write a mark to log files
 when no message has been logged for more than @var{max-silent-time} seconds."
-  (service provision
-           #:requirement requirement
-           #:start (lambda ()
-                     (let ((channel (make-channel))
-                           (ports (append (open-sockets sources)
-                                          (if kernel-log-file
-                                              (list (open kernel-log-file
-                                                          (logior O_RDONLY
-                                                                  O_NONBLOCK
-                                                                  O_CLOEXEC)))
-                                              '())))
-                           (dispatcher (spawn-log-dispatcher 
message-destination
-                                                             #:max-silent-time
-                                                             max-silent-time)))
-                       (spawn-fiber
-                        (lambda ()
-                          (run-system-log channel ports dispatcher)))
-                       (system-log channel ports dispatcher)))
-           #:stop (lambda (system-log)
-                    (let ((reply (make-channel)))
-                      (put-message (system-log-channel system-log)
-                                   `(terminate ,reply))
-                      (get-message reply)         ;wait for complete shutdown
-                      #f))
-           #:respawn? #f))
-
+  (define this-system-log
+    (service provision
+             #:requirement requirement
+             #:start (lambda ()
+                       (let ((channel (make-channel))
+                             (ports (append (open-sockets sources)
+                                            (if kernel-log-file
+                                                (list (open kernel-log-file
+                                                            (logior O_RDONLY
+                                                                    O_NONBLOCK
+                                                                    
O_CLOEXEC)))
+                                                '())))
+                             (dispatcher (spawn-log-dispatcher 
message-destination
+                                                               
#:max-silent-time
+                                                               
max-silent-time)))
+                         (register-service-logger this-system-log dispatcher)
+                         (spawn-fiber
+                          (lambda ()
+                            (run-system-log channel ports dispatcher)))
+                         (system-log channel ports dispatcher)))
+             #:stop (lambda (system-log)
+                      (let ((reply (make-channel)))
+                        (put-message (system-log-channel system-log)
+                                     `(terminate ,reply))
+                        (get-message reply)         ;wait for complete shutdown
+                        #f))
+             #:respawn? #f))
+
+  this-system-log)
diff --git a/tests/services/system-log.sh b/tests/services/system-log.sh
index 729cf62..78e3c15 100644
--- a/tests/services/system-log.sh
+++ b/tests/services/system-log.sh
@@ -150,13 +150,32 @@ do
     cat "$file"
 done
 
+for file in "$syslog_file" "$syslog_auth_file" "$syslog_debug_file" \
+                          "$syslog_remote_file"
+do
+    $herd status system-log | grep "Log files: .*$file"
+done
+
 $herd stop system-log
 $herd eval root '(gc)'
 
 if test -d "/proc/$$/fd"       # GNU/Hurd lacks /proc/*/fd.
 then
     # At this point, shepherd should be back to INITIAL_FD_COUNT.
-    ls -l "/proc/$(cat $pid)/fd"
+    # Since the logger's own ports are closed asynchronously, when the service
+    # sends it the 'terminate message, retry a few times.
+    i=0
+    while test $i -lt 20
+    do
+       ls -l "/proc/$(cat $pid)/fd"
+       if test $(file_descriptor_count) -le $initial_fd_count
+       then
+           break
+       else
+           sleep 0.5           # wait and retry
+           i=$(expr $i + 1)
+       fi
+    done
     test $(file_descriptor_count) -le $initial_fd_count
 fi