[shepherd] 03/03: logger: Factorize ‘open-log-file’ procedure.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 10e106e39182447ff947fc7f8ff6949f3ecc05e6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed May 15 22:44:58 2024 +0200

    logger: Factorize ‘open-log-file’ procedure.
    
    * modules/shepherd/logger.scm (open-log-file): New procedure, with code
    formerly in ‘%service-file-logger’.
    (%service-file-logger): Use it.
---
 modules/shepherd/logger.scm | 30 +++++++++++++++++++-----------
 1 file changed, 19 insertions(+), 11 deletions(-)

diff --git a/modules/shepherd/logger.scm b/modules/shepherd/logger.scm
index c439248..6c3b35f 100644
--- a/modules/shepherd/logger.scm
+++ b/modules/shepherd/logger.scm
@@ -93,25 +93,33 @@ first message received."
                       (get-operation channel1)
                       (get-operation channel2))))
 
+(define* (open-log-file file #:optional (mode #o640))
+  "Open @var{file} as a log file, close-on-exec, in append mode, with UTF-8
+encoding, etc."
+  (let* ((fd     (open-fdes file (logior O_CREAT O_WRONLY O_APPEND O_CLOEXEC)
+                            mode))
+         (output (fdopen fd "al")))
+    (set-port-encoding! output "UTF-8")
+    (set-port-conversion-strategy! output 'substitute)
+    output))
+
 (define* (%service-file-logger channel file input
                                #:key
                                (service (current-service))
                                (history-size (default-log-history-size)))
   "Like 'service-file-logger', but doesn't handle the case in which FILE does
 not exist."
-  (let* ((fd     (open-fdes file (logior O_CREAT O_WRONLY O_APPEND O_CLOEXEC)
-                            #o640))
-         (output (fdopen fd "al"))
-         (lines  (make-channel)))
-    (set-port-encoding! output "UTF-8")
-    (set-port-conversion-strategy! output 'substitute)
-    (lambda ()
-      (spawn-fiber (line-reader input lines))
+  (define lines
+    (make-channel))
+
+  (lambda ()
+    (spawn-fiber (line-reader input lines))
 
-      (when service
-        ;; Associate this logger with SERVICE.
-        (register-service-logger service channel))
+    (when service
+      ;; Associate this logger with SERVICE.
+      (register-service-logger service channel))
 
+    (let log ((output (open-log-file file)))
       (call-with-port output
         (lambda (output)
           (let loop ((messages (ring-buffer history-size))