[shepherd] 02/04: service: Add #:bind-attempts to 'endpoint'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit ad13d2cb99600a61518cfddf8bdae81ce2b2789c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu May 18 23:11:52 2023 +0200

    service: Add #:bind-attempts to 'endpoint'.
    
    * modules/shepherd/service.scm (<endpoint>)[bind-attempts]: New field.
    * modules/shepherd/service.scm (default-bind-attempts): New variable.
    (endpoint): Add #:bind-attempts.
    (bind/retry-if-in-use): Change default value.
    (endpoint->listening-socket): Honor 'bind-attempts'.
    * doc/shepherd.texi (Service De- and Constructors): Document it.
    * NEWS: Update.
---
 NEWS                         |  7 +++++++
 doc/shepherd.texi            | 12 +++++++++++-
 modules/shepherd/service.scm | 30 ++++++++++++++++++++++--------
 3 files changed, 40 insertions(+), 9 deletions(-)

diff --git a/NEWS b/NEWS
index 9d3c950..7fdfdba 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,13 @@ Copyright © 2013-2014, 2016, 2018-2020, 2022-2023 Ludovic 
Courtès <ludo@gnu.or
 
 Please send Shepherd bug reports to bug-guix@gnu.org.
 
+* Changes in 0.10.1
+
+** Configurable number of ‘bind’ attempts for endpoints
+
+The ‘endpoint’ procedure takes a new ‘#:bind-attempts’ parameter.  Its default
+value is (default-bind-attempts), itself a new SRFI-39 parameter.
+
 * Changes in 0.10.0
 
 ** Distinguish ‘starting’ and ‘stopping’ intermediate service statuses
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index bbe0d8c..f6ce44b 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -1107,7 +1107,8 @@ using the @code{endpoint} procedure:
 @deffn {Procedure} endpoint @var{address} [#:name "unknown"] @
   [#:style SOCK_STREAM] [#:backlog 128] @
   [#:socket-owner (getuid)] [#:socket-group (getgid)] @
-  [#:socket-directory-permissions #o755]
+  [#:socket-directory-permissions #o755] @
+  [#:bind-attempts (default-bind-attempts)]
 Return a new endpoint called @var{name} of @var{address}, an address as
 return by @code{make-socket-address}, with the given @var{style} and
 @var{backlog}.
@@ -1130,8 +1131,17 @@ When @var{address} is of type @code{AF_UNIX}, 
@var{socket-owner} and
 @var{socket-group} are strings or integers that specify its ownership and that
 of its parent directory; @var{socket-directory-permissions} specifies the
 permissions for its parent directory.
+
+Upon @samp{EADDRINUSE} (``Address already in use''), up to @var{bind-attempts}
+attempts will be made to @code{bind} on @var{address}, one every second.
 @end deffn
 
+@defvar default-bind-attempts
+This parameter specifies the number of times, by default, that
+@command{shepherd} will try to bind an endpoint address if it happens to
+be already in use.
+@end defvar
+
 The inetd service constructor takes a command and a list of such
 endpoints:
 
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index fa1926c..e3ca910 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -119,6 +119,8 @@
             endpoint-socket-owner
             endpoint-socket-group
             endpoint-socket-directory-permissions
+            endpoint-bind-attempts
+            default-bind-attempts
             make-systemd-constructor
             make-systemd-destructor
 
@@ -1737,7 +1739,8 @@ waiting for the shell to terminate."
 
 ;; Endpoint of a systemd-style or inetd-style service.
 (define-record-type <endpoint>
-  (make-endpoint name address style backlog owner group permissions)
+  (make-endpoint name address style backlog owner group permissions
+                 bind-attempts)
   endpoint?
   (name        endpoint-name)                          ;string
   (address     endpoint-address)                       ;socket address
@@ -1745,13 +1748,19 @@ waiting for the shell to terminate."
   (backlog     endpoint-backlog)                       ;integer
   (owner       endpoint-socket-owner)                  ;integer
   (group       endpoint-socket-group)                  ;integer
-  (permissions endpoint-socket-directory-permissions)) ;integer
+  (permissions endpoint-socket-directory-permissions)  ;integer
+  (bind-attempts endpoint-bind-attempts))              ;integer
+
+(define default-bind-attempts
+  ;; Default number of 'bind' attempts upon EADDRINUSE.
+  (make-parameter 5))
 
 (define* (endpoint address
                    #:key (name "unknown") (style SOCK_STREAM)
                    (backlog 128)
                    (socket-owner (getuid)) (socket-group (getgid))
-                   (socket-directory-permissions #o755))
+                   (socket-directory-permissions #o755)
+                   (bind-attempts (default-bind-attempts)))
   "Return a new endpoint called @var{name} of @var{address}, an address as
 return by @code{make-socket-address}, with the given @var{style} and
 @var{backlog}.
@@ -1763,13 +1772,17 @@ IPv6, you need two endpoints.
 When @var{address} is of type @code{AF_UNIX}, @var{socket-owner} and
 @var{socket-group} are strings or integers that specify its ownership and that
 of its parent directory; @var{socket-directory-permissions} specifies the
-permissions for its parent directory."
+permissions for its parent directory.
+
+Upon @samp{EADDRINUSE} (``Address already in use''), up to @var{bind-attempts}
+attempts will be made to @code{bind} on @var{address}, one every second."
   (make-endpoint name address style backlog
                  socket-owner socket-group
-                 socket-directory-permissions))
+                 socket-directory-permissions
+                 bind-attempts))
 
 (define* (bind/retry-if-in-use sock address
-                               #:key (max-attempts 5))
+                               #:key (max-attempts (default-bind-attempts)))
   "Bind @var{sock} to @var{address}.  Retry up to @var{max-attempts} times upon
 EADDRINUSE."
   (let loop ((attempts 1))
@@ -1792,7 +1805,7 @@ retrying to bind it in one second.")
   "Return a listening socket for ENDPOINT."
   (match endpoint
     (($ <endpoint> name address style backlog
-                   owner group permissions)
+                   owner group permissions bind-attempts)
      ;; Make listening sockets SOCK_CLOEXEC: inetd-style services don't pass
      ;; them to the child process, and systemd-style do pass them but call
      ;; 'dup2' right before 'exec', thereby clearing this property.
@@ -1816,7 +1829,8 @@ retrying to bind it in one second.")
          (catch-system-error (delete-file (sockaddr:path address))))
 
        (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
-       (bind/retry-if-in-use sock address)
+       (bind/retry-if-in-use sock address
+                             #:max-attempts bind-attempts)
        (listen sock backlog)
 
        (when (= AF_UNIX (sockaddr:fam address))