civodul pushed a commit to branch wip-syslogd
in repository shepherd.
commit 768333225bcde6c4a35d88cee22d23ddddf390c5
Author: Ludovic Courtès <[email protected]>
AuthorDate: Tue Jul 23 23:45:18 2024 +0200
squash! Log messages from /proc/kmsg.
---
modules/shepherd/service/system-log.scm | 119 ++++++++++++++++++++++----------
tests/services/system-log-internal.scm | 12 ++++
tests/services/system-log.sh | 14 +++-
3 files changed, 107 insertions(+), 38 deletions(-)
diff --git a/modules/shepherd/service/system-log.scm
b/modules/shepherd/service/system-log.scm
index 9185776..3919f2a 100644
--- a/modules/shepherd/service/system-log.scm
+++ b/modules/shepherd/service/system-log.scm
@@ -47,6 +47,7 @@
read-system-log-message
+ kernel-log-file
system-log-service))
;; Message sent to the system log (minus its timestamp).
@@ -155,14 +156,17 @@ or a <system-log-message> object."
(apply throw args))))
socket))
-(define (wait-for-input-or-message socket channel)
- "Wait for input on @var{socket} or messages on @var{channel}. Return
-@var{socket} when input is available or the message received on @var{channel}."
+(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
+available or the message received on @var{channel}."
(perform-operation
- (choice-operation
- (wrap-operation (wait-until-port-readable-operation socket)
- (const socket))
- (get-operation channel))))
+ (apply choice-operation
+ (get-operation channel)
+ (map (lambda (port)
+ (wrap-operation (wait-until-port-readable-operation port)
+ (const port)))
+ ports))))
(define (maybe-utf8->string bv)
"Attempt to decode BV as UTF-8 string and return it. Gracefully handle the
@@ -174,34 +178,55 @@ case where BV does not contain only valid UTF-8."
;; Fall back to something that should be safe.
(bytevector->string bv "ISO-8859-1" 'substitute))))
-(define (run-system-log channel socket dispatcher)
- "Return the system log, getting instructions on @var{channel}, receiving
-messages to be logged on @var{socket} and passing them to @var{dispatcher}."
- (define (input-marker? x)
- (eq? x socket))
+(define (socket? port)
+ "Return true if @var{port} is backed by a socket."
+ (catch 'system-error
+ (lambda ()
+ (getsockname port))
+ (const #f)))
+(define (run-system-log channel ports dispatcher)
+ "Return the system log, getting instructions on @var{channel}, receiving
+messages to be logged on @var{ports}, a list of sockets or other file ports,
+and passing them to @var{dispatcher}."
(define buffer
(make-bytevector 1024))
+ (define (log-bytes buffer bytes)
+ (let ((bytes (if (= (char->integer #\newline)
+ (bytevector-u8-ref buffer (- bytes 1)))
+ (- bytes 1)
+ bytes)))
+ (put-message dispatcher
+ (parse-system-log-message
+ (maybe-utf8->string
+ (bytevector-slice buffer 0 bytes))))))
+
+ (define socket-port?
+ ;; Since 'socket?' incurs one syscall per port, do it only once. Since
+ ;; there are usually more sockets than non-socket ports, keep the list of
+ ;; of non-socket ports.
+ (let ((non-socket (remove socket? ports)))
+ (lambda (obj)
+ ;; Return true if OBJ is a port and is backed by a socket.
+ (and (input-port? obj)
+ (not (memq obj non-socket))))))
+
(let loop ()
- (match (wait-for-input-or-message socket channel)
- ((? input-marker?)
+ (match (wait-for-input-or-message ports channel)
+ ((? socket-port? socket) ;socket such as /dev/log
(match (recvfrom! socket buffer)
- ((0 . _)
- #t)
- ((bytes . sender)
- (let ((bytes (if (= (char->integer #\newline)
- (bytevector-u8-ref buffer (- bytes 1)))
- (- bytes 1)
- bytes)))
- (put-message dispatcher
- (parse-system-log-message
- (maybe-utf8->string
- (bytevector-slice buffer 0 bytes)))))))
+ ((0 . _) #t)
+ ((bytes . sender) (log-bytes buffer bytes)))
+ (loop))
+ ((? input-port? port) ;regular file like /proc/kmsg
+ (match (read-line port)
+ ((? eof-object?) #t)
+ (line (put-message dispatcher (parse-system-log-message line))))
(loop))
(('terminate reply)
(local-output (l10n "Terminating system log service."))
- (close-port socket)
+ (for-each close-port ports)
(put-message dispatcher `(terminate ,reply))))))
(define %heartbeat-message
@@ -214,6 +239,12 @@ messages to be logged on @var{socket} and passing them to
@var{dispatcher}."
"Dispatch system log messages received on @var{channel} to log files. Call
@var{log-files} 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))
@@ -221,6 +252,9 @@ file(s)."
(localtime now))))
;; Avoid (ice-9 format) to reduce heap allocations.
(put-string output prefix)
+ (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))
@@ -305,36 +339,51 @@ the file(s) returned by @var{log-files} for each message."
'())))
(const (list (in-vicinity %user-log-dir "syslog")))))
+(define kernel-log-file
+ ;; File to read to get kernel messages.
+ (make-parameter "/proc/kmsg"))
+
(define* (system-log-service #:optional (file (system-log-file))
#:key
(provision '(system-log syslogd))
(requirement '())
+ (kernel-log-file (and (zero? (getuid))
+ (kernel-log-file)))
(log-files (default-log-file-procedure))
(max-silent-time (* 20 60)))
"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-files}, 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."
+connections on @var{file}, a Unix-domain socket; optionally it also reads
+messages from @code{#:kernel-log-file}, which defaults to @file{/proc/kmsg}
+when running as root.
+
+Log messages are passed to @var{log-files}, 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."
(define channel
(make-channel))
(service provision
#:requirement requirement
#:start (lambda ()
- (let ((socket (open-socket file))
+ (let ((sockets (cons (open-socket file)
+ (if kernel-log-file
+ (list (open kernel-log-file
+ (logior O_RDONLY
+ O_NONBLOCK
+ O_CLOEXEC)))
+ '())))
(dispatcher (spawn-log-dispatcher log-files
#:max-silent-time
max-silent-time)))
(spawn-fiber
(lambda ()
- (run-system-log channel socket dispatcher)))
- socket))
- #:stop (lambda (socket)
+ (run-system-log channel sockets dispatcher)))
+ sockets))
+ #:stop (lambda (sockets)
(let ((reply (make-channel)))
- (close-port socket)
(put-message channel `(terminate ,reply))
(get-message reply) ;wait for complete shutdown
#f))
#:respawn? #f))
+
diff --git a/tests/services/system-log-internal.scm
b/tests/services/system-log-internal.scm
index 4101909..bdbc7f0 100644
--- a/tests/services/system-log-internal.scm
+++ b/tests/services/system-log-internal.scm
@@ -58,4 +58,16 @@ sudo: ludo : TTY=pts/0 ; PWD=/home/ludo ; USER=root ;
COMMAND=xyz"
(system-log-message-priority message)
(system-log-message-content message))))))
+(test-equal "read-system-log-message, kernel"
+ (list (system-log-facility kernel)
+ (system-log-priority info)
+ "[370383.514474] usb 1-2: USB disconnect, device number 57")
+ (call-with-input-string
+ "<6>[370383.514474] usb 1-2: USB disconnect, device number 57"
+ (lambda (port)
+ (let ((message (read-system-log-message port)))
+ (list (system-log-message-facility message)
+ (system-log-message-priority message)
+ (system-log-message-content message))))))
+
(test-end)
diff --git a/tests/services/system-log.sh b/tests/services/system-log.sh
index 1ab7431..cec729b 100644
--- a/tests/services/system-log.sh
+++ b/tests/services/system-log.sh
@@ -24,6 +24,7 @@ conf="t-conf-$$"
log="t-log-$$"
pid="t-pid-$$"
logger="$PWD/t-syslog-logger-$$.scm"
+kmsg="$PWD/t-syslog-kmsg-$$"
syslog_file="$PWD/t-syslog-$$"
syslog_auth_file="$PWD/t-syslog-auth-$$"
syslog_debug_file="$PWD/t-syslog-debug-$$"
@@ -32,7 +33,7 @@ syslog_socket="$PWD/t-syslog-socket-$$"
herd="herd -s $socket"
trap "cat $log || true;
- rm -f $socket $conf $log $logger $syslog_socket;
+ rm -f $socket $conf $log $logger $kmsg $syslog_socket;
rm -f $syslog_file $syslog_auth_file $syslog_debug_file;
test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT
@@ -55,7 +56,8 @@ cat > "$conf" <<EOF
(register-services
(list (system-log-service "$syslog_socket"
- #:log-files log-files)
+ #:log-files log-files
+ #:kernel-log-file "$kmsg")
(service
'(logger)
#:requirement '(syslogd)
@@ -82,6 +84,10 @@ EOF
chmod +x "$logger"
+cat > "$kmsg" <<EOF
+<6>[370383.514474] usb 1-2: USB disconnect, device number 57
+EOF
+
file_descriptor_count ()
{
ls -l /proc/"$(cat $pid)"/fd/[0-9]* | wc -l
@@ -104,17 +110,19 @@ $herd start logger
until $herd status logger | grep stopped; do sleep 0.3; done
grep "starting logger" "$log"
+
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 "USB disconnect, device number 57" "$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 3
+test $(wc -l < "$syslog_file") -eq 4
for file in "$syslog_file" "$syslog_auth_file" "$syslog_debug_file"
do
