civodul pushed a commit to branch devel
in repository shepherd.
commit de31c3074e02288f9686d462d693687ff1a27231
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Fri Aug 9 22:33:53 2024 +0200
system-log: Use ‘log-line’ from (shepherd logger).
* modules/shepherd/logger.scm (log-line): Export.
* modules/shepherd/service/system-log.scm (%kernel-prefix): New
variable, formerly in ‘log-dispatcher’.
(system-log-message->string): New procedure.
(%heartbeat-message): Pass to ‘system-log-message->string’.
(log-dispatcher)[kernel-prefix, log-line]: Remove.
Use ‘system-log-message->string’ together with ‘log-line’ from (shepherd
logger).
---
modules/shepherd/logger.scm | 2 ++
modules/shepherd/service/system-log.scm | 61 ++++++++++++++++-----------------
2 files changed, 31 insertions(+), 32 deletions(-)
diff --git a/modules/shepherd/logger.scm b/modules/shepherd/logger.scm
index bb756f5..c82a959 100644
--- a/modules/shepherd/logger.scm
+++ b/modules/shepherd/logger.scm
@@ -41,6 +41,8 @@
logger-files
rotate-log-file
+ ;; Internal helpers.
+ log-line
open-log-file
rotate-and-reopen-log-file))
diff --git a/modules/shepherd/service/system-log.scm
b/modules/shepherd/service/system-log.scm
index 51d4af7..6c5794e 100644
--- a/modules/shepherd/service/system-log.scm
+++ b/modules/shepherd/service/system-log.scm
@@ -23,6 +23,7 @@
#:use-module (shepherd support)
#:autoload (shepherd config) (%localstatedir)
#:autoload (shepherd logger) (open-log-file
+ log-line
rotate-and-reopen-log-file)
#:autoload (shepherd comm) (system-log-file)
#:use-module (srfi srfi-1)
@@ -147,6 +148,26 @@ or @code{#f}) as its sender."
((? eof-object? eof) eof)
(line (parse-system-log-message line sender))))
+(define %kernel-prefix
+ ;; Prefix from messages coming from the "kernel" facility.
+ (if (string-contains %host-type "linux")
+ "linux: "
+ "vmunix: ")) ;old style
+
+(define (system-log-message->string message)
+ "Return a string representing @var{message}, a system log message, as it
+will be printed."
+ (string-append (or (and=> (system-log-message-sender message)
+ (lambda (address)
+ (string-append (socket-address->string address)
+ " ")))
+ "localhost ")
+ (if (= (system-log-message-facility message)
+ (system-log-facility kernel))
+ %kernel-prefix
+ "")
+ (system-log-message-content message)))
+
(define (wait-for-input-or-message ports channel)
"Wait for input on @var{ports}, a list of input ports, or for messages on
@var{channel}. Return one of the elements of @var{ports} when input is
@@ -225,40 +246,15 @@ and passing them to @var{dispatcher}."
(define %heartbeat-message
;; Message logged when nothing was logged for a while.
- (system-log-message (logior (system-log-facility internal/mark)
- (system-log-priority info))
- "-- MARK --" #f))
+ (system-log-message->string
+ (system-log-message (logior (system-log-facility internal/mark)
+ (system-log-priority info))
+ "-- MARK --" #f)))
(define* (log-dispatcher channel message-destination #:key max-silent-time)
"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)."
- (define kernel-prefix
- ;; Prefix from messages coming from the "kernel" facility.
- (if (string-contains %host-type "linux")
- "linux: "
- "vmunix: ")) ;old style
-
- (define (log-line message output)
- ;; Write MESSAGE to OUTPUT and return its timestamp.
- (let* ((now (current-time))
- (prefix (strftime default-logfile-date-format
- (localtime now))))
- ;; Avoid (ice-9 format) to reduce heap allocations.
- (put-string output prefix)
- (put-string output
- (or (and=> (system-log-message-sender message)
- (lambda (address)
- (string-append (socket-address->string address)
- " ")))
- "localhost "))
- (when (= (system-log-message-facility message)
- (system-log-facility kernel))
- (put-string output kernel-prefix))
- (put-string output (system-log-message-content message))
- (newline output)
- now))
-
(define default-message-destination
(default-message-destination-procedure))
@@ -275,14 +271,15 @@ destination file(s)."
#:warning
(l10n "Uncaught exception \
in message destination procedure: "))
- (default-message-destination message))))
+ (default-message-destination message)))
+ (line (system-log-message->string message)))
(loop (fold (lambda (file ports)
(match (vhash-assoc file ports)
(#f
(catch 'system-error
(lambda ()
(let ((port (open-log-file file)))
- (log-line message port)
+ (log-line line port)
(vhash-cons file port ports)))
(lambda args
(local-output
@@ -290,7 +287,7 @@ in message destination procedure: "))
file (strerror (system-error-errno args)))
ports)))
((_ . port)
- (log-line message port)
+ (log-line line port)
ports)))
ports
files))))
