[shepherd] 03/04: service: Built-in logger logs the PID of the service.

[Ludovic Courtès]

civodul pushed a commit to branch wip-logging
in repository shepherd.

commit cc8ea8a0cac55bd9b9eaa2da85dbdef05b93acdd
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Dec 1 22:34:29 2023 +0100

    service: Built-in logger logs the PID of the service.
    
    * modules/shepherd/service.scm (%service-file-logger): Add ‘service’
    parameter.
    (service-file-logger): Add #:service and pass it to
    ‘%service-file-logger’.
    (service-builtin-logger): Add #:service.  Thread ‘pid’ through ‘loop’;
    initialize it and display it when it is known.
---
 modules/shepherd/service.scm | 40 +++++++++++++++++++++++-----------------
 1 file changed, 23 insertions(+), 17 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 7768d2b..0fe7675 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1405,7 +1405,7 @@ on @var{channel}."
          (put-message channel (string-take line count))
          (loop))))))
 
-(define (%service-file-logger file input)
+(define (%service-file-logger file input service)
   "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)
@@ -1431,41 +1431,47 @@ not exist."
                  (newline output)
                  (loop))))))))))
 
-(define (service-file-logger file input)
-  "Return a thunk meant to run as a fiber that reads from INPUT and logs it to
-FILE."
+(define* (service-file-logger file input
+                              #:key (service (current-service)))
+  "Return a thunk meant to run as a fiber that reads from @var{input} and logs 
it
+to @var{file}.  Assume it's logging for @var{service}."
   (catch 'system-error
     (lambda ()
-      (%service-file-logger file input))
+      (%service-file-logger file input service))
     (lambda args
       (if (= ENOENT (system-error-errno args))
           (begin
             (mkdir-p (dirname file))
-            (%service-file-logger file input))
+            (%service-file-logger file input service))
           (apply throw args)))))
 
-(define (service-builtin-logger command input)
+(define* (service-builtin-logger command input
+                                 #:key (service (current-service)))
   "Return a thunk meant to run as a fiber that reads from @var{input} and logs 
to
-@code{log-output-port}."
+@code{log-output-port}.  Assume it's logging for @var{service}."
   (lambda ()
     (define lines (make-channel))
 
     (spawn-fiber (line-reader input lines))
-    (let loop ()
+    (let loop ((pid #f))
       (match (get-message lines)
         ((? eof-object?)
          #t)
         (line
-         (let ((prefix (strftime (%current-logfile-date-format)
+         (let ((pid (or pid
+                        (and service
+                             (eq? 'running (service-status service))
+                             (service-running-value service))))
+               (prefix (strftime (%current-logfile-date-format)
                                  (localtime (current-time)))))
-           ;; TODO: Print the PID of COMMAND.  The actual PID is potentially
-           ;; not known until after 'read-pid-file' has completed, so it would
-           ;; need to be communicated.
-           (simple-format (log-output-port) "~a[~a] "
-                          prefix command)
+           (if (integer? pid)
+               (simple-format (log-output-port) "~a~a[~a] "
+                              prefix command pid)
+               (simple-format (log-output-port) "~a[~a] "
+                              prefix command))
            (put-string (log-output-port) line)
-           (newline (log-output-port)))
-         (loop))))))
+           (newline (log-output-port))
+           (loop pid)))))))
 
 (define (format-supplementary-groups supplementary-groups)
   (list->vector (map (lambda (group) (group:gid (getgr group)))