civodul pushed a commit to branch wip-syslogd
in repository shepherd.
commit e1c344dba0026eb4845b8a15fdb2554d46db27d1
Author: Ludovic Courtès <[email protected]>
AuthorDate: Sun Aug 4 11:33:27 2024 +0200
squash! Support for AF_INET endpoints and sender logging.
---
modules/shepherd/service/system-log.scm | 39 ++++++++++++++++++++++-----------
tests/services/system-log.sh | 30 +++++++++++++++++++------
2 files changed, 49 insertions(+), 20 deletions(-)
diff --git a/modules/shepherd/service/system-log.scm
b/modules/shepherd/service/system-log.scm
index 3e601ec..810e980 100644
--- a/modules/shepherd/service/system-log.scm
+++ b/modules/shepherd/service/system-log.scm
@@ -43,6 +43,7 @@
system-log-message-facility
system-log-message-priority
system-log-message-content
+ system-log-message-sender
system-log-priority
system-log-facility
@@ -54,10 +55,11 @@
;; Message sent to the system log (minus its timestamp).
(define-record-type <system-log-message>
- (system-log-message priority+facility content)
+ (system-log-message priority+facility content sender)
system-log-message?
(priority+facility system-log-message-priority+facility)
- (content system-log-message-content))
+ (content system-log-message-content)
+ (sender system-log-message-sender)) ;#f | socket address
(define-syntax define-enumerate-type
(syntax-rules ()
@@ -123,24 +125,25 @@
(define %default-priority (system-log-priority notice))
(define %default-facility (system-log-facility user))
-(define (parse-system-log-message line)
+(define* (parse-system-log-message line #:optional sender)
"Parse @var{line} and return a @code{<system-log-message>} record
representing it."
(match (false-if-exception (regexp-exec %system-log-message-rx line))
(#f
(system-log-message (logior %default-facility %default-priority)
- line))
+ line sender))
(m
(let* ((facility+priority (string->number (match:substring m 1))))
(system-log-message facility+priority
- (match:substring m 3))))))
+ (match:substring m 3) sender)))))
-(define (read-system-log-message port)
+(define* (read-system-log-message port #:optional sender)
"Read a system log message from @var{port}. Return the end-of-file object
-or a <system-log-message> object."
+or a <system-log-message> object, with @var{sender} (either a socket address
+or @code{#f}) as its sender."
(match (read-line port)
((? eof-object? eof) eof)
- (line (parse-system-log-message line))))
+ (line (parse-system-log-message line sender))))
(define (wait-for-input-or-message ports channel)
"Wait for input on @var{ports}, a list of input ports, or for messages on
@@ -178,7 +181,7 @@ and passing them to @var{dispatcher}."
(define buffer
(make-bytevector 1024))
- (define (log-bytes buffer bytes)
+ (define (log-bytes buffer bytes sender)
(let ((bytes (if (= (char->integer #\newline)
(bytevector-u8-ref buffer (- bytes 1)))
(- bytes 1)
@@ -186,7 +189,8 @@ and passing them to @var{dispatcher}."
(put-message dispatcher
(parse-system-log-message
(maybe-utf8->string
- (bytevector-slice buffer 0 bytes))))))
+ (bytevector-slice buffer 0 bytes))
+ sender))))
(define socket-port?
;; Since 'socket?' incurs one syscall per port, do it only once. Since
@@ -203,7 +207,7 @@ and passing them to @var{dispatcher}."
((? socket-port? socket) ;socket such as /dev/log
(match (recvfrom! socket buffer)
((0 . _) #t)
- ((bytes . sender) (log-bytes buffer bytes)))
+ ((bytes . sender) (log-bytes buffer bytes sender)))
(loop))
((? input-port? port) ;regular file like /proc/kmsg
(match (read-line port)
@@ -219,7 +223,7 @@ and passing them to @var{dispatcher}."
;; Message logged when nothing was logged for a while.
(system-log-message (logior (system-log-facility internal/mark)
(system-log-priority info))
- "-- MARK --"))
+ "-- MARK --" #f))
(define* (log-dispatcher channel log-files #:key max-silent-time)
"Dispatch system log messages received on @var{channel} to log files. Call
@@ -238,6 +242,12 @@ file(s)."
(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))
@@ -255,7 +265,10 @@ file(s)."
(get-message channel))
((? system-log-message? message)
;; Write MESSAGE to the target file(s).
- (let ((files (or (false-if-exception (log-files message))
+ (let ((files (or (false-if-exception
+ (log-files message)
+ #:warning
+ (l10n "Uncaught exception in log files procedure:
"))
(default-log-files message))))
(loop (fold (lambda (file ports)
(match (vhash-assoc file ports)
diff --git a/tests/services/system-log.sh b/tests/services/system-log.sh
index 0b10d8f..33b50fa 100644
--- a/tests/services/system-log.sh
+++ b/tests/services/system-log.sh
@@ -28,13 +28,14 @@ kmsg="$PWD/t-syslog-kmsg-$$"
syslog_file="$PWD/t-syslog-$$"
syslog_auth_file="$PWD/t-syslog-auth-$$"
syslog_debug_file="$PWD/t-syslog-debug-$$"
+syslog_remote_file="$PWD/t-syslog-remote-$$"
syslog_socket="$PWD/t-syslog-socket-$$"
herd="herd -s $socket"
trap "cat $log || true;
rm -f $socket $conf $log $logger $kmsg $syslog_socket;
- rm -f $syslog_file $syslog_auth_file $syslog_debug_file;
+ rm -f $syslog_file $syslog_auth_file $syslog_debug_file
$syslog_remote_file;
test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT
cat > "$conf" <<EOF
@@ -43,7 +44,9 @@ cat > "$conf" <<EOF
(define (log-files message)
(pk 'log-files->
- (cond ((= (system-log-message-facility message)
+ (cond ((system-log-message-sender message)
+ (list "$syslog_remote_file"))
+ ((= (system-log-message-facility message)
(system-log-facility authorization/private))
(list "$syslog_auth_file"))
((= (system-log-message-facility message)
@@ -55,12 +58,14 @@ cat > "$conf" <<EOF
(else
(list "$syslog_file")))))
-(define %endpoint
- (endpoint (make-socket-address AF_UNIX "$syslog_socket")
- #:style SOCK_DGRAM))
+(define %endpoints
+ (list (endpoint (make-socket-address AF_UNIX "$syslog_socket")
+ #:style SOCK_DGRAM)
+ (endpoint (make-socket-address AF_INET INADDR_LOOPBACK 9898)
+ #:style SOCK_DGRAM)))
(register-services
- (list (system-log-service (list %endpoint)
+ (list (system-log-service %endpoints
#:log-files log-files
#:kernel-log-file "$kmsg")
(service
@@ -74,6 +79,7 @@ EOF
cat > "$logger" <<EOF
#!$GUILE --no-auto-compile
!#
+(use-modules (rnrs bytevectors))
(display "starting logger\n")
(let ((sock (socket AF_UNIX SOCK_DGRAM 0)))
@@ -85,6 +91,13 @@ cat > "$logger" <<EOF
(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 "<20>Jul 18 22:22:22 exim[42]: too much mail in your inbox\n" sock))
+
+(let ((sock (socket AF_INET SOCK_DGRAM 0))
+ (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")
+ address))
EOF
chmod +x "$logger"
@@ -124,12 +137,15 @@ 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"
+grep "mtp-probe:" "$syslog_remote_file"
test $(wc -l < "$syslog_auth_file") -eq 3
test $(wc -l < "$syslog_debug_file") -eq 1
+test $(wc -l < "$syslog_remote_file") -eq 1
test $(wc -l < "$syslog_file") -eq 4
-for file in "$syslog_file" "$syslog_auth_file" "$syslog_debug_file"
+for file in "$syslog_file" "$syslog_auth_file" "$syslog_debug_file" \
+ "$syslog_remote_file"
do
cat "$file"
done
