;; GNU Shepherd --- Test the system log service.
;; Copyright © 2024-2025 Ludovic Courtès <ludo@gnu.org>
;;
;; This file is part of the GNU Shepherd.
;;
;; The GNU Shepherd is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or (at
;; your option) any later version.
;;
;; The GNU Shepherd is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-system-log-internal)
  #:use-module (shepherd service system-log)
  #:use-module (srfi srfi-64))

(define (call-with-c-locale thunk)
  (let ((previous #f))
    (dynamic-wind
      (lambda () (set! previous (setlocale LC_ALL "C")))
      thunk
      (lambda () (setlocale LC_ALL previous)))))

(define-syntax-rule (with-c-locale exp)
  (call-with-c-locale (lambda () exp)))


(test-begin "system-log-internal")

(test-equal "read-system-log-message, with PID"
  (list (system-log-facility daemon)
        (system-log-priority notice)
        "wpa_supplicant[303]: wlp0s20f0u2: CTRL-EVENT-BEACON-LOSS")
  (call-with-input-string "<29>Jun 22 16:41:31 wpa_supplicant[303]: \
wlp0s20f0u2: CTRL-EVENT-BEACON-LOSS"
    (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-equal "read-system-log-message, without PID"
  (list (system-log-facility authorization/private)
        (system-log-priority notice)
        "sudo: ludo : TTY=pts/0 ; PWD=/home/ludo ; USER=root ; COMMAND=xyz")
  (call-with-input-string "<85>Aug  5 10:45:55 \
sudo: ludo : TTY=pts/0 ; PWD=/home/ludo ; USER=root ; COMMAND=xyz"
    (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-equal "read-system-log-message, with Unicode and C locale"
  (list (system-log-facility daemon)
        (system-log-priority debug)
        "prosody[198]: Ϫ")
  ;; This used to trigger a bug whereby 'regexp-exec' (in Guile 3.0.9) would
  ;; incorrectly compute match boundaries when running in a non-Unicode
  ;; capable locale: <https://issues.guix.gnu.org/77283>.
  (call-with-input-string "<31>Mar 26 16:41:31 prosody[198]: Ϫ"
    (lambda (port)
      (let ((message (with-c-locale (read-system-log-message port))))
        (list (system-log-message-facility message)
              (system-log-message-priority message)
              (system-log-message-content message))))))

(test-equal "read-system-log-message, raw"
  (list (system-log-facility user)
        (system-log-priority notice)
        "shepherd[1]: Stopping service tor...")
  ;; This message lacks the usual syslog header.
  (call-with-input-string "shepherd[1]: Stopping service tor...\n"
    (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-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)
