civodul pushed a commit to branch devel
in repository shepherd.
commit 8883bee0aec49108775eee49c690897a2f253222
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Tue Aug 6 23:21:50 2024 +0200
logger: Change ‘file’ to ‘files’ (plural).
* modules/shepherd/logger.scm (%service-file-logger): Change 'file
request to 'files and adjust reply accordingly. Add argument to
'rotate and handle it.
(service-builtin-logger, service-system-logger): Likewise.
(logger-file): Rename to…
(logger-files): … this, and send 'files request (plural).
(rotate-log-file): Add ‘file’ parameter and pass it to LOGGER.
* modules/shepherd/scripts/herd.scm (<live-service>)[log-file]: Rename to…
[log-files]: … this.
(sexp->live-service): Adjust accordingly.
(display-service-status): Likewise.
* modules/shepherd/service.scm (service-log-file): Rename to…
(service-log-files): … this.
(service->sexp): Change ‘log-file’ to ‘log-files’.
* modules/shepherd/service/log-rotation.scm (rotate-logs): Iterate over
the ‘logger-files’ list.
(log-rotation-service): Likewise.
* tests/status-sexp.sh: Change ‘log-file’ to ‘log-files’.
---
modules/shepherd/logger.scm | 84 +++++++++++++++++--------------
modules/shepherd/scripts/herd.scm | 18 ++++---
modules/shepherd/service.scm | 12 +++--
modules/shepherd/service/log-rotation.scm | 32 ++++++------
tests/status-sexp.sh | 8 +--
5 files changed, 83 insertions(+), 71 deletions(-)
diff --git a/modules/shepherd/logger.scm b/modules/shepherd/logger.scm
index a8f9886..9937507 100644
--- a/modules/shepherd/logger.scm
+++ b/modules/shepherd/logger.scm
@@ -38,7 +38,7 @@
spawn-service-system-logger
logger-recent-messages
- logger-file
+ logger-files
rotate-log-file
open-log-file))
@@ -157,30 +157,38 @@ not exist."
(('recent-messages reply)
(put-message reply (ring-buffer->list messages))
(loop messages service))
- (('file reply)
- (put-message reply file)
+ (('files reply)
+ (put-message reply (list file))
(loop messages service))
- (('rotate rotated-file reply)
- (local-output (l10n "Rotating '~a' to '~a'.")
- file rotated-file)
- (newline output)
- (log-line (l10n "Rotating log.") output)
- (close-port output)
- (let ((output (catch 'system-error
- (lambda ()
- (rename-file file rotated-file)
- (open-log-file file))
- (lambda args
- args))))
- (put-message reply (port? output))
- (if (port? output)
- (log output messages service)
- (begin
- (local-output
- (l10n "Failed to rotate '~a' to '~a': ~a.")
- file rotated-file
- (strerror (system-error-errno output)))
- (loop messages service)))))
+ (('rotate requested-file rotated-file reply)
+ (if (string=? requested-file file)
+ (begin
+ (local-output (l10n "Rotating '~a' to '~a'.")
+ file rotated-file)
+ (newline output)
+ (log-line (l10n "Rotating log.") output)
+ (close-port output)
+ (let ((output (catch 'system-error
+ (lambda ()
+ (rename-file file rotated-file)
+ (open-log-file file))
+ (lambda args
+ args))))
+ (put-message reply (port? output))
+ (if (port? output)
+ (log output messages service)
+ (begin
+ (local-output
+ (l10n "Failed to rotate '~a' to '~a': ~a.")
+ file rotated-file
+ (strerror (system-error-errno output)))
+ (loop messages service)))))
+ (begin
+ (local-output (l10n "Ignoring request to \
+rotate '~a' (log file is '~a').")
+ requested-file file)
+ (put-message reply #f)
+ (loop messages service))))
(line
(let ((now (log-line line output)))
(loop (ring-buffer-insert (cons now line)
@@ -260,10 +268,10 @@ to @var{history-size} lines in memory."
(('recent-messages reply)
(put-message reply (ring-buffer->list messages))
(loop pid messages service))
- (('file reply)
- (put-message reply #f) ;not logged to a file
+ (('files reply)
+ (put-message reply '()) ;not logged to a file
(loop pid messages service))
- (('rotate _ reply) ;nothing to rotate
+ (('rotate _ _ reply) ;nothing to rotate
(put-message reply #f)
(loop pid messages service))
(line
@@ -336,10 +344,10 @@ it's logging for @var{service}."
(('recent-messages reply)
(put-message reply (ring-buffer->list messages))
(loop messages service))
- (('file reply)
- (put-message reply #f) ;not logged to a file
+ (('files reply)
+ (put-message reply '()) ;not logged to a file
(loop messages service))
- (('rotate _ reply) ;nothing to rotate
+ (('rotate _ _ reply) ;nothing to rotate
(put-message reply #f)
(loop messages service))
(line
@@ -379,14 +387,14 @@ reply."
;; Return the list of timestamp/string for recently logged messages.
(logger-control-message 'recent-messages))
-(define logger-file
- ;; Return the file name the log is written to or #f if there is none.
- (logger-control-message 'file))
+(define logger-files
+ ;; Return the file names the log is written to, possibly the empty list.
+ (logger-control-message 'files))
-(define (rotate-log-file logger rotated-file)
- "Ask @var{logger} to atomically rename its log file to @var{rotated-file}
-and re-open its log file with the same name as before. Return @code{#f} on
-failure--e.g., ENOSPC or @var{logger} is not file-backed."
+(define (rotate-log-file logger file rotated-file)
+ "Ask @var{logger} to atomically rename its log file @var{file} to
+@var{rotated-file} and to re-open it with the same name as before. Return
+@code{#f} on failure--e.g., ENOSPC or @var{logger} is not file-backed."
(let ((reply (make-channel)))
- (put-message logger `(rotate ,rotated-file ,reply))
+ (put-message logger `(rotate ,file ,rotated-file ,reply))
(get-message reply)))
diff --git a/modules/shepherd/scripts/herd.scm
b/modules/shepherd/scripts/herd.scm
index f9fbf58..a2c9253 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -47,7 +47,7 @@
enabled? status running
status-changes last-respawns startup-failures
exit-statuses
- recent-messages log-file
+ recent-messages log-files
pending-replacement?)
live-service?
(provision live-service-provision) ;list of symbols
@@ -64,7 +64,7 @@
(startup-failures live-service-startup-failures) ;list of integers
(exit-statuses live-service-process-exit-statuses) ;integers/timestamps
(recent-messages live-service-recent-messages) ;list of strings
- (log-file live-service-log-file) ;#f | string
+ (log-files live-service-log-files) ;list of strings
(pending-replacement? live-service-pending-replacement?)) ;Boolean
(define (live-service-canonical-name service)
@@ -118,7 +118,7 @@ into a @code{live-service} record."
(alist-let* properties (provides requires status running respawn? enabled?
status-changes last-respawns startup-failures
exit-statuses
- recent-messages log-file
+ recent-messages log-files
one-shot? transient? pending-replacement?)
(live-service provides requires one-shot?
transient? respawn?
@@ -131,7 +131,7 @@ into a @code{live-service} record."
(or startup-failures '())
(or exit-statuses '())
(or recent-messages '())
- log-file
+ (or log-files '())
pending-replacement?)))))
(define (highlight-if-long-transient-status service)
@@ -514,9 +514,13 @@ to upgrade).~%"))))
(format #t (highlight/error (l10n " Failed to start at ~a.~%"))
(time->string time)))
(_ #t)))
- (when (live-service-log-file service)
- (format #t (l10n " Log file: ~a.~%")
- (live-service-log-file service)))
+ (match (live-service-log-files service)
+ (() #t)
+ (files
+ (format #t (l10n " Log file:~{ ~a~}.~%"
+ " Log files:~{ ~a~}.~%"
+ (length files))
+ (live-service-log-files service))))
(when show-recent-messages?
(match (live-service-running-value service)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index bc8852d..fb42d97 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -83,7 +83,7 @@
service-replacement
service-logger
service-recent-messages
- service-log-file
+ service-log-files
service-action-list
lookup-service-action
@@ -826,9 +826,11 @@ channel and wait for its reply."
(or (and=> (service-logger service) logger-recent-messages)
'()))
-(define (service-log-file service)
- "Return file where @var{service} logs messages, #f if there is none."
- (and=> (service-logger service) logger-file))
+(define (service-log-files service)
+ "Return the files where @var{service} logs messages, the empty list of there
+are none."
+ (or (and=> (service-logger service) logger-files)
+ '()))
(define (enable-service service)
"Enable @var{service}."
@@ -1165,7 +1167,7 @@ clients."
(respawn-delay ,(service-respawn-delay service))
(exit-statuses ,(service-process-exit-statuses service))
(recent-messages ,(service-recent-messages service))
- (log-file ,(service-log-file service))
+ (log-files ,(service-log-files service))
(pending-replacement? ,(->bool (service-replacement service)))))
diff --git a/modules/shepherd/service/log-rotation.scm
b/modules/shepherd/service/log-rotation.scm
index 66721ad..64eb1cd 100644
--- a/modules/shepherd/service/log-rotation.scm
+++ b/modules/shepherd/service/log-rotation.scm
@@ -25,6 +25,7 @@
timer-trigger-action)
#:autoload (shepherd service) (service
service-logger
+ service-log-files
service-canonical-name
for-each-service
action)
@@ -162,15 +163,14 @@ previously-archived log files. Compress the log file of
@var{logger}
according to @var{method}. Call @var{rotate} with the old a new file name for
each rotation. If the size of the log file is below
@var{rotation-size-threshold}, do not rotate it."
- (match (logger-file logger)
- (#f #f)
- (file
- (rotate-file file
- #:rotate rotate
- #:rotate-current (lambda (file next)
- (rotate-log-file logger next))
- #:compression compression
- #:rotation-size-threshold rotation-size-threshold))))
+ (for-each (lambda (file)
+ (rotate-file file
+ #:rotate rotate
+ #:rotate-current (lambda (file next)
+ (rotate-log-file logger file
next))
+ #:compression compression
+ #:rotation-size-threshold rotation-size-threshold))
+ (logger-files logger)))
(define* (rotate-service-logs #:optional (rotate rename-file)
#:key
@@ -268,14 +268,12 @@ only if the service that mounts the file system that
hosts log files is up."
(action 'files
(lambda _
(for-each-service (lambda (service)
- (match (service-logger service)
- (#f #f)
- (logger
- (let ((file (logger-file logger)))
- (when file
- (format #t "~a\t~a~%"
- file (service-canonical-name
- service))))))))
+ (define name
+ (service-canonical-name service))
+ (for-each (lambda (file)
+ (format #t "~a\t~a~%"
+ file name))
+ (service-log-files service))))
(for-each (lambda (file)
;; TRANSLATORS: "External" here refers to "external
;; log files".
diff --git a/tests/status-sexp.sh b/tests/status-sexp.sh
index 9e8d4e3..d62ab56 100644
--- a/tests/status-sexp.sh
+++ b/tests/status-sexp.sh
@@ -93,7 +93,7 @@ root_service_sexp="
(respawn-delay 0.1)
(exit-statuses ())
(recent-messages ())
- (log-file \"$PWD/$log\")
+ (log-files (\"$PWD/$log\"))
(pending-replacement? #f))"
# Define a helper procedure that resets timestamps in the 'status-changes'
@@ -150,7 +150,7 @@ $define_canonicalize
(respawn-limit (5 . 7)) (respawn-delay 1)
(exit-statuses ())
(recent-messages ())
- (log-file #f)
+ (log-files ())
(pending-replacement? #f))
(service (version 0)
(provides (bar)) (requires (foo))
@@ -164,7 +164,7 @@ $define_canonicalize
(respawn-limit (5 . 7)) (respawn-delay 1)
(exit-statuses ())
(recent-messages ())
- (log-file #f)
+ (log-files ())
(pending-replacement? #f)))))))
"
@@ -196,7 +196,7 @@ $define_canonicalize
(respawn-limit (5 . 7)) (respawn-delay 1)
(exit-statuses ())
(recent-messages ())
- (log-file #f)
+ (log-files ())
(pending-replacement? #f))))))
"
