civodul pushed a commit to branch devel
in repository shepherd.
commit d759b794f759ed19f16080762e54a25c5b81ed76
Author: Ludovic Courtès <[email protected]>
AuthorDate: Sat May 18 11:44:23 2024 +0200
logger: Add support for race-free log rotation.
* modules/shepherd/logger.scm (%service-file-logger)[log-line]: New
procedure.
Add clause for 'rotate messages. Use ‘log-line’ when receiving a line.
(service-builtin-logger): Add clause for 'rotate messages.
(rotate-log-file): New procedure.
---
modules/shepherd/logger.scm | 60 +++++++++++++++++++++++++++++++++++++--------
1 file changed, 50 insertions(+), 10 deletions(-)
diff --git a/modules/shepherd/logger.scm b/modules/shepherd/logger.scm
index 6c3b35f..ba09926 100644
--- a/modules/shepherd/logger.scm
+++ b/modules/shepherd/logger.scm
@@ -37,7 +37,8 @@
spawn-service-builtin-logger
logger-recent-messages
- logger-file))
+ logger-file
+ rotate-log-file))
(define default-log-history-size
;; Number of lines of service log kept in memory by default.
@@ -112,6 +113,17 @@ not exist."
(define lines
(make-channel))
+ (define (log-line line output)
+ ;; Write LINE to OUTPUT and return its timestamp.
+ (let* ((now (current-time))
+ (prefix (strftime default-logfile-date-format
+ (localtime now))))
+ ;; Avoid (ice-9 format) to reduce heap allocations.
+ (put-string output prefix)
+ (put-string output line)
+ (newline output)
+ now))
+
(lambda ()
(spawn-fiber (line-reader input lines))
@@ -119,10 +131,12 @@ not exist."
;; Associate this logger with SERVICE.
(register-service-logger service channel))
- (let log ((output (open-log-file file)))
+ (let log ((output (open-log-file file))
+ (messages (ring-buffer history-size))
+ (service service))
(call-with-port output
(lambda (output)
- (let loop ((messages (ring-buffer history-size))
+ (let loop ((messages messages)
(service service))
(match (get-message/choice lines channel)
((? eof-object?)
@@ -143,14 +157,29 @@ not exist."
(('file reply)
(put-message reply 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)))))
(line
- (let* ((now (current-time))
- (prefix (strftime default-logfile-date-format
- (localtime now))))
- ;; Avoid (ice-9 format) to reduce heap allocations.
- (put-string output prefix)
- (put-string output line)
- (newline output)
+ (let ((now (log-line line output)))
(loop (ring-buffer-insert (cons now line)
messages)
service))))))))))
@@ -225,6 +254,9 @@ to @var{history-size} lines in memory."
(('file reply)
(put-message reply #f) ;not logged to a file
(loop pid messages service))
+ (('rotate _ reply) ;nothing to rotate
+ (put-message reply #f)
+ (loop pid messages service))
(line
(let* ((pid (or pid
(and service
@@ -278,3 +310,11 @@ reply."
(define logger-file
;; Return the file name the log is written to or #f if there is none.
(logger-control-message 'file))
+
+(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."
+ (let ((reply (make-channel)))
+ (put-message logger `(rotate ,rotated-file ,reply))
+ (get-message reply)))
