civodul pushed a commit to branch devel
in repository shepherd.
commit 1f5fdf772922a7edcb303fe0d39f4f95b07487c4
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Fri Aug 9 23:06:50 2024 +0200
system-log: Keep recent messages in a ring buffer.
* modules/shepherd/logger.scm (log-line): Make ‘now’ an optional
parameter.
* modules/shepherd/service/system-log.scm (log-dispatcher):
Add #:history-size. Add ‘messages’ variable to ‘loop’; insert new
elements into ‘messages’ when new messages are received.
(spawn-log-dispatcher): Add #:history-size and pass it.
(system-log-service): Add #:history-size and pass it.
* tests/services/system-log.sh: Check the “Recent messages” output of
‘herd status system-log’.
* doc/shepherd.texi (System Log Service): Document #:history-size.
---
doc/shepherd.texi | 4 +++
modules/shepherd/logger.scm | 10 +++---
modules/shepherd/service/system-log.scm | 55 ++++++++++++++++++++++-----------
tests/services/system-log.sh | 8 ++++-
4 files changed, 53 insertions(+), 24 deletions(-)
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index b45bb93..90c5593 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -2053,6 +2053,7 @@ host (see below).
[#:requirement '()] @
[#:kernel-log-file (kernel-log-file)] @
[#:message-destination (default-message-destination-procedure)] @
+ [#:history-size (default-log-history-size)] @
[#:max-silent-time (default-max-silent-time)]
Return the system log service (@dfn{syslogd}) with the given
@var{provision} and @var{requirement} (lists of symbols). The service accepts
@@ -2063,6 +2064,9 @@ 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.
+
+Keep up to @var{history-size} messages in memory for the purposes of allowing
+users to view recent messages without opening various files.
@end deffn
@deffn {Procedure} default-message-destination-procedure
diff --git a/modules/shepherd/logger.scm b/modules/shepherd/logger.scm
index c82a959..3d15d62 100644
--- a/modules/shepherd/logger.scm
+++ b/modules/shepherd/logger.scm
@@ -100,11 +100,11 @@ first message received."
(get-operation channel1)
(get-operation channel2))))
-(define (log-line line output)
- "Write @var{line} to @var{output} and return its timestamp."
- (let* ((now (current-time))
- (prefix (strftime default-logfile-date-format
- (localtime now))))
+(define* (log-line line output #:optional (now (current-time)))
+ "Write @var{line} to @var{output} with @var{now} as its timestamp; return
+@var{now}."
+ (let ((prefix (strftime default-logfile-date-format
+ (localtime now))))
;; Avoid (ice-9 format) to reduce heap allocations.
(put-string output prefix)
(put-string output line)
diff --git a/modules/shepherd/service/system-log.scm
b/modules/shepherd/service/system-log.scm
index 6c5794e..89fad46 100644
--- a/modules/shepherd/service/system-log.scm
+++ b/modules/shepherd/service/system-log.scm
@@ -22,7 +22,8 @@
#:use-module (shepherd service)
#:use-module (shepherd support)
#:autoload (shepherd config) (%localstatedir)
- #:autoload (shepherd logger) (open-log-file
+ #:autoload (shepherd logger) (default-log-history-size
+ open-log-file
log-line
rotate-and-reopen-log-file)
#:autoload (shepherd comm) (system-log-file)
@@ -251,7 +252,10 @@ and passing them to @var{dispatcher}."
(system-log-priority info))
"-- MARK --" #f)))
-(define* (log-dispatcher channel message-destination #:key max-silent-time)
+(define* (log-dispatcher channel message-destination
+ #:key
+ max-silent-time
+ (history-size (default-log-history-size)))
"Dispatch system log messages received on @var{channel} to log files. Call
@var{message-destination} for each system log message to determine the
destination file(s)."
@@ -259,7 +263,8 @@ destination file(s)."
(default-message-destination-procedure))
(lambda ()
- (let loop ((ports vlist-null))
+ (let loop ((ports vlist-null)
+ (messages (ring-buffer history-size)))
(match (if max-silent-time
(get-message* channel max-silent-time 'timeout)
(get-message channel))
@@ -272,6 +277,7 @@ destination file(s)."
(l10n "Uncaught exception \
in message destination procedure: "))
(default-message-destination message)))
+ (now (current-time))
(line (system-log-message->string message)))
(loop (fold (lambda (file ports)
(match (vhash-assoc file ports)
@@ -279,7 +285,7 @@ in message destination procedure: "))
(catch 'system-error
(lambda ()
(let ((port (open-log-file file)))
- (log-line line port)
+ (log-line line port now)
(vhash-cons file port ports)))
(lambda args
(local-output
@@ -287,26 +293,27 @@ in message destination procedure: "))
file (strerror (system-error-errno args)))
ports)))
((_ . port)
- (log-line line port)
+ (log-line line port now)
ports)))
ports
- files))))
+ files)
+ (ring-buffer-insert (cons now line) messages))))
('timeout
;; Write a mark to all the files indiscriminately.
(vhash-fold (lambda (file port _)
(log-line %heartbeat-message port))
#t
ports)
- (loop ports))
+ (loop ports messages))
(('recent-messages reply)
- (put-message reply '()) ;TODO: implement it
- (loop ports))
+ (put-message reply (ring-buffer->list messages))
+ (loop ports messages))
(('files reply)
(put-message reply (vhash-fold (lambda (file _ lst)
(cons file lst))
'()
ports))
- (loop ports))
+ (loop ports messages))
(('rotate file rotated-file reply)
(match (vhash-assoc file ports)
(#f
@@ -314,14 +321,15 @@ in message destination procedure: "))
system log file '~a'.")
file)
(put-message reply #f)
- (loop ports))
+ (loop ports messages))
((_ . port)
(let ((port (rotate-and-reopen-log-file port file
rotated-file)))
(put-message reply (port? port))
(if (port? port)
- (loop (vhash-cons file port (vhash-delete file ports)))
- (loop ports))))))
+ (loop (vhash-cons file port (vhash-delete file ports))
+ messages)
+ (loop ports messages))))))
('terminate
(local-output (l10n "Closing ~a system log ports.")
(vlist-length ports))
@@ -331,12 +339,17 @@ system log file '~a'.")
#t
ports))))))
-(define* (spawn-log-dispatcher message-destination #:key max-silent-time)
+(define* (spawn-log-dispatcher message-destination
+ #:key
+ max-silent-time
+ (history-size (default-log-history-size)))
"Spawn the log dispatcher, responsible for writing system log messages to
-the file(s) returned by @var{message-destination} for each message."
+the file(s) returned by @var{message-destination} for each message. Keep up
+to @var{history-size} messages in a ring buffer."
(let ((channel (make-channel)))
(spawn-fiber (log-dispatcher channel message-destination
- #:max-silent-time max-silent-time))
+ #:max-silent-time max-silent-time
+ #:history-size history-size))
channel))
(define (default-message-destination-procedure)
@@ -404,6 +417,7 @@ default destination to log it to."
(kernel-log-file)))
(message-destination
(default-message-destination-procedure))
+ (history-size (default-log-history-size))
(max-silent-time (default-max-silent-time)))
"Return the system log service (@dfn{syslogd}) with the given
@var{provision} and @var{requirement} (lists of symbols). The service accepts
@@ -413,7 +427,10 @@ 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."
+when no message has been logged for more than @var{max-silent-time} seconds.
+
+Keep up to @var{history-size} messages in memory for the purposes of allowing
+users to view recent messages without opening various files."
(define this-system-log
(service provision
#:requirement requirement
@@ -428,7 +445,9 @@ when no message has been logged for more than
@var{max-silent-time} seconds."
'())))
(dispatcher (spawn-log-dispatcher
message-destination
#:max-silent-time
-
max-silent-time)))
+ max-silent-time
+ #:history-size
+ history-size)))
(register-service-logger this-system-log dispatcher)
(spawn-fiber
(lambda ()
diff --git a/tests/services/system-log.sh b/tests/services/system-log.sh
index 742bcea..3f2cd4f 100644
--- a/tests/services/system-log.sh
+++ b/tests/services/system-log.sh
@@ -111,7 +111,7 @@ cat > "$logger" <<EOF
(address (make-socket-address AF_INET INADDR_LOOPBACK 9898)))
(sendto sock
(string->utf8
- "<31>Aug 4 10:05:55 localhost mtp-probe: checking bus 1, device
111: \"/sys/devices/pci0000:00/0000:00:14.0/usb1/1-8\"\n")
+ "<31>Aug 4 10:05:55 mtp-probe: checking bus 1, device 111:
\"/sys/devices/pci0000:00/0000:00:14.0/usb1/1-8\"\n")
address))
EOF
@@ -171,6 +171,12 @@ do
$herd status system-log | grep "Log files: .*$file"
done
+# Check the "Recent messages" part of 'herd status'.
+$herd status system-log
+$herd status system-log | grep "sudo: pam_unix"
+$herd status system-log | grep "USB disconnect"
+$herd status system-log | grep "mtp-probe: "
+
# Ensure logs can be rotated.
$herd start log-rotation
$herd trigger log-rotation
