From b06ecc57515d4e3c8b2228e8142654e9a26ba6e1 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 29 Apr 2022 22:53:22 +0200
Subject: services: guix-publish: Use socket activation when possible.

* gnu/services/base.scm (guix-publish-shepherd-service): Use
'make-systemd-constructor' when it's available and ADVERTISE? is false.
---
 gnu/services/base.scm | 49 +++++++++++++++++++++++++++++++------------------
 1 file changed, 31 insertions(+), 18 deletions(-)

(limited to 'gnu/services')

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 5d7c69a9cd..f1649eb084 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1877,13 +1877,7 @@ (define (config->compression-options config)
   (match-record config <guix-publish-configuration>
     (guix port host nar-path cache workers ttl negative-ttl
           cache-bypass-threshold advertise?)
-    (list (shepherd-service
-           (provision '(guix-publish))
-           (requirement `(user-processes
-                          guix-daemon
-                          ,@(if advertise? '(avahi-daemon) '())))
-           (start #~(make-forkexec-constructor
-                     (list #$(file-append guix "/bin/guix")
+    (let ((command #~(list #$(file-append guix "/bin/guix")
                            "publish" "-u" "guix-publish"
                            "-p" #$(number->string port)
                            #$@(config->compression-options config)
@@ -1913,17 +1907,36 @@ (define (config->compression-options config)
                                         "--cache-bypass-threshold="
                                         (number->string
                                          cache-bypass-threshold)))
-                                  #~()))
-
-                     ;; Make sure we run in a UTF-8 locale so we can produce
-                     ;; nars for packages that contain UTF-8 file names such
-                     ;; as 'nss-certs'.  See <https://bugs.gnu.org/26948>.
-                     #:environment-variables
-                     (list (string-append "GUIX_LOCPATH="
-                                          #$glibc-utf8-locales "/lib/locale")
-                           "LC_ALL=en_US.utf8")
-                     #:log-file "/var/log/guix-publish.log"))
-           (stop #~(make-kill-destructor))))))
+                                  #~())))
+          (options #~(#:environment-variables
+                      ;; Make sure we run in a UTF-8 locale so we can produce
+                      ;; nars for packages that contain UTF-8 file names such
+                      ;; as 'nss-certs'.  See <https://bugs.gnu.org/26948>.
+                      (list (string-append "GUIX_LOCPATH="
+                                           #$glibc-utf8-locales "/lib/locale")
+                            "LC_ALL=en_US.utf8")
+                      #:log-file "/var/log/guix-publish.log"))
+          (endpoints #~(let ((ai (false-if-exception
+                                  (getaddrinfo #$host
+                                               #$(number->string port)
+                                               AI_NUMERICSERV))))
+                         (if (pair? ai)
+                             (list (endpoint (addrinfo:addr (car ai))))
+                             '()))))
+      (list (shepherd-service
+             (provision '(guix-publish))
+             (requirement `(user-processes
+                            guix-daemon
+                            ,@(if advertise? '(avahi-daemon) '())))
+
+             ;; Use lazy socket activation unless ADVERTISE? is true: in that
+             ;; case the process should start right away to advertise itself.
+             (start #~(if (and (defined? 'make-systemd-constructor) ;> 0.9.0?
+                               #$(not advertise?))
+                          (make-systemd-constructor
+                           #$command #$endpoints #$@options)
+                          (make-forkexec-constructor #$command #$@options)))
+             (stop #~(make-kill-destructor)))))))
 
 (define %guix-publish-accounts
   (list (user-group (name "guix-publish") (system? #t))
-- 
cgit v1.2.3