[Ludovic Courtès]

branch: main
commit ff7d9b36a21df77f80891baf4032673d4a66404c
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Fri Mar 21 17:27:34 2025 +0100

    utils: Define ‘activation-sockets’.
    
    * src/cuirass/utils.scm (activation-sockets): New procedure.
---
 src/cuirass/utils.scm | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index 204988c..862e0e1 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -60,6 +60,7 @@
             gather-user-privileges
             open-unix-listening-socket
             non-blocking-port
+            activation-sockets
 
             atomic-box-fetch-and-increment!
             atomic-box-fetch-and-decrement!
@@ -342,6 +343,31 @@ its parent directory if needed and make it #o700."
       (fcntl port F_SETFL (logior O_NONBLOCK flags)))
     port))
 
+(define (activation-sockets)
+  "If this program is being spawned through systemd-style \"socket
+activation\", whereby listening sockets are passed as file descriptor 3 and
+above, return the list of socket name/file descriptor pairs provided by the
+service manager."
+  (define not-colon
+    (char-set-complement (char-set #\:)))
+
+  (if (equal? (and=> (getenv "LISTEN_PID") string->number)
+              (getpid))
+      (match (getenv "LISTEN_FDS")
+        ((= string->number count)
+         (map (lambda (name fd)
+                (let ((sock (fdopen fd "r+0")))
+                  (cons (string->symbol name)
+                        (non-blocking-port sock))))
+              (or (and=> (getenv "LISTEN_FDNAMES")
+                         (lambda (str)
+                           (string-tokenize str not-colon)))
+                  '())
+              (iota count 3)))
+        (_
+         '()))
+      '()))
+
 
 ;;;
 ;;; Atomic procedures.