civodul pushed a commit to branch wip-syslogd
in repository shepherd.
commit 917b9b50c78e9a06e1f4ed98e1612512b04e5d27
Author: Ludovic Courtès <[email protected]>
AuthorDate: Thu Jul 18 23:05:04 2024 +0200
squash! #:log-files returns a list of files rather than a single file.
---
modules/shepherd/service/system-log.scm | 78 +++++++++++++++++++++++----------
tests/services/system-log.sh | 21 +++++----
2 files changed, 68 insertions(+), 31 deletions(-)
diff --git a/modules/shepherd/service/system-log.scm
b/modules/shepherd/service/system-log.scm
index 1a672af..302d9f0 100644
--- a/modules/shepherd/service/system-log.scm
+++ b/modules/shepherd/service/system-log.scm
@@ -23,6 +23,7 @@
#:autoload (shepherd config) (%localstatedir)
#:autoload (shepherd logger) (open-log-file)
#:autoload (shepherd comm) (system-log-file)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
@@ -218,10 +219,10 @@ messages to be logged on @var{socket} and passing them to
@var{dispatcher}."
(close-port socket)
(put-message dispatcher `(terminate ,reply))))))
-(define (log-dispatcher channel log-file)
+(define (log-dispatcher channel log-files)
"Dispatch system log messages received on @var{channel} to log files. Call
-@var{log-file} for each system log message to determine the destination file
-name."
+@var{log-files} for each system log message to determine the destination
+file(s)."
(define (log-line message output)
;; Write MESSAGE to OUTPUT and return its timestamp.
(let* ((now (current-time))
@@ -240,23 +241,34 @@ name."
(newline output)
now))
- (define default-log-file
+ (define default-log-files
(default-log-file-procedure))
(lambda ()
(let loop ((ports vlist-null))
(match (get-message channel)
((? system-log-message? message)
- (let ((file (or (false-if-exception (log-file message))
- (default-log-file message))))
- (match (vhash-assoc file ports)
- (#f
- (let ((port (open-log-file file)))
- (log-line message port)
- (loop (vhash-cons file port ports))))
- ((_ . port)
- (log-line message port)
- (loop ports)))))
+ ;; Write MESSAGE to the target file(s).
+ (let ((files (or (false-if-exception (log-files message))
+ (default-log-files 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)
+ (vhash-cons file port ports)))
+ (lambda args
+ (local-output
+ (l10n "Failed to open log file '~a': ~a")
+ file (strerror (system-error-errno args)))
+ ports)))
+ ((_ . port)
+ (log-line message port)
+ ports)))
+ ports
+ files))))
(('terminate reply)
(local-output (l10n "Closing ~a system log ports.")
(vlist-length ports))
@@ -267,28 +279,48 @@ name."
ports)
(put-message reply #t))))))
-(define (spawn-log-dispatcher log-file)
+(define (spawn-log-dispatcher log-files)
"Spawn the log dispatcher, responsible for writing system log messages to
-the file returned by @var{log-file} for each message."
+the file(s) returned by @var{log-files} for each message."
(let ((channel (make-channel)))
- (spawn-fiber (log-dispatcher channel log-file))
+ (spawn-fiber (log-dispatcher channel log-files))
channel))
(define (default-log-file-procedure)
(if (zero? (getuid))
- (const (in-vicinity %localstatedir "log/syslog"))
- (const (in-vicinity %user-log-dir "syslog"))))
+ (lambda (message)
+ `(,@(if (member (system-log-message-facility message)
+ (list (system-log-facility mail)
+ (system-log-facility authorization/private)))
+ '()
+ (list (in-vicinity %localstatedir "log/messages")
+ "/dev/tty12"))
+ ,@(if (member (system-log-message-priority message)
+ (list (system-log-priority emergency)
+ (system-log-priority alert)))
+ '("/dev/console")
+ '())
+ ,@(if (= (system-log-message-priority message)
+ (system-log-priority debug))
+ (list (in-vicinity %localstatedir "log/debug"))
+ '())
+ ,@(if (member (system-log-message-facility message)
+ (list (system-log-facility authorization)
+ (system-log-facility authorization/private)))
+ (list (in-vicinity %localstatedir "log/secure"))
+ '())))
+ (const (list (in-vicinity %user-log-dir "syslog")))))
(define* (system-log-service #:optional (file (system-log-file))
#:key
(provision '(system-log syslogd))
(requirement '())
- (log-file (default-log-file-procedure)))
+ (log-files (default-log-file-procedure)))
"Return the system log service (@dfn{syslogd}) with the given
@var{provision} and @var{requirement} (lists of symbols). The service accepts
connections on @var{file}, a Unix-domain socket. Log messages are passed to
-@var{log-file}, a one-argument procedure that must return the name of the file
-to write to."
+@var{log-files}, a one-argument procedure that must return the list of files
+to write it to."
(define channel
(make-channel))
@@ -296,7 +328,7 @@ to write to."
#:requirement requirement
#:start (lambda ()
(let ((socket (open-socket file))
- (dispatcher (spawn-log-dispatcher log-file)))
+ (dispatcher (spawn-log-dispatcher log-files)))
(spawn-fiber
(lambda ()
(run-system-log channel socket dispatcher)))
diff --git a/tests/services/system-log.sh b/tests/services/system-log.sh
index 074f949..1ab7431 100644
--- a/tests/services/system-log.sh
+++ b/tests/services/system-log.sh
@@ -39,20 +39,23 @@ trap "cat $log || true;
cat > "$conf" <<EOF
(use-modules (shepherd service system-log))
-(define (log-file message)
- (pk 'log-file->
+(define (log-files message)
+ (pk 'log-files->
(cond ((= (system-log-message-facility message)
(system-log-facility authorization/private))
- "$syslog_auth_file")
+ (list "$syslog_auth_file"))
+ ((= (system-log-message-facility message)
+ (system-log-facility mail))
+ '()) ;too much mail: discard these messages
((= (system-log-message-priority message)
(system-log-priority debug))
- "$syslog_debug_file")
+ (list "$syslog_debug_file" "$syslog_file"))
(else
- "$syslog_file"))))
+ (list "$syslog_file")))))
(register-services
(list (system-log-service "$syslog_socket"
- #:log-file log-file)
+ #:log-files log-files)
(service
'(logger)
#:requirement '(syslogd)
@@ -73,7 +76,8 @@ cat > "$logger" <<EOF
(display "<81>Jul 14 12:33:01 sudo: ludo : 3 incorrect password attempts ;
TTY=pts/34\n" sock)
(display "<31>Jul 14 12:18:28 ntpd[427]: new interface(s) found: waking up
resolver\n" sock)
(display "<38>Jul 14 12:47:33 elogind[286]: Power key pressed short.\n" sock)
- (display "<30>Jul 14 12:47:33 NetworkManager[319]: <info> [1720954053.6685]
manager: sleep: sleep requested\n" sock))
+ (display "<30>Jul 14 12:47:33 NetworkManager[319]: <info> [1720954053.6685]
manager: sleep: sleep requested\n" sock)
+ (display "<20>Jul 18 22:22:22 exim[42]: too much mail in your inbox\n" sock))
EOF
chmod +x "$logger"
@@ -104,12 +108,13 @@ grep "sudo:.* session opened" "$syslog_auth_file"
grep "sudo:.* authentication failure" "$syslog_auth_file"
grep "3 incorrect password attempts" "$syslog_auth_file"
grep "ntpd\[427\]: new interface" "$syslog_debug_file"
+grep "ntpd\[427\]: new interface" "$syslog_file" # this one in both files
grep "elogind\[286\]: Power key pressed short" "$syslog_file"
grep "NetworkManager\[319\]: .*sleep" "$syslog_file"
test $(wc -l < "$syslog_auth_file") -eq 3
test $(wc -l < "$syslog_debug_file") -eq 1
-test $(wc -l < "$syslog_file") -eq 2
+test $(wc -l < "$syslog_file") -eq 3
for file in "$syslog_file" "$syslog_auth_file" "$syslog_debug_file"
do
