From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id mMTnKVz/hGLn9AAAbAwnHQ (envelope-from ) for ; Wed, 18 May 2022 16:14:52 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id KFThKVz/hGIBIAEA9RJhRA (envelope-from ) for ; Wed, 18 May 2022 16:14:52 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 2E0BE8810 for ; Wed, 18 May 2022 16:14:52 +0200 (CEST) Received: from localhost ([::1]:32778 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nrKRv-0002dP-2i for larch@yhetil.org; Wed, 18 May 2022 10:14:51 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:46952) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nrKLK-0003KC-KF for bug-guix@gnu.org; Wed, 18 May 2022 10:08:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:39186) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nrKLK-0000k4-Bq for bug-guix@gnu.org; Wed, 18 May 2022 10:08:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nrKLK-0003tz-7A for bug-guix@gnu.org; Wed, 18 May 2022 10:08:02 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#55335: [PATCH Shepherd 1/3] service: 'make-inetd-constructor' accepts a list of endpoints. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Wed, 18 May 2022 14:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 55335 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: 55335@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 55335-submit@debbugs.gnu.org id=B55335.165288283314923 (code B ref 55335); Wed, 18 May 2022 14:08:02 +0000 Received: (at 55335) by debbugs.gnu.org; 18 May 2022 14:07:13 +0000 Received: from localhost ([127.0.0.1]:33078 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nrKKW-0003sb-L5 for submit@debbugs.gnu.org; Wed, 18 May 2022 10:07:13 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53336) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nrKKP-0003rM-H6 for 55335@debbugs.gnu.org; Wed, 18 May 2022 10:07:06 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:58646) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nrKKJ-0000d2-0W; Wed, 18 May 2022 10:06:59 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=zWEXQK4+c0kwJXUklc5tuDS2DmkWMHz1KjO2KWfKF0U=; b=lDQt8PL7snT0S9fBBIvU kq9nuZVVZxWhy+9xXE6C6101Y4HAAQOtBlUu555v6jN+ide5JqOF15JjCrecnBcCa6ECi7PTweXlM SwQoa7uS2cSrhd2nKnThx/l8q3V9Ff5yoIq75n6ZUhHCqFY4sEl+or8xJLJH/ICI5Tze27HN/d1oV hUv/1NHjxecspCqslUy+fDfRQ/xTBkzT7ZIv1/XwYCVZQGaKPr/Rahk6GxdnZIcGdzfGUDZoUYA5F vPlaj2bpdcnwp7SzbosUV4ZfLwJ0PywflU32JMBAXJz+F9TlhVW8dJzrCgVb+9efNbAUlw5Z2cEB9 k7gZ7A2XXZO17w==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:56764 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nrKKI-0003x7-Js; Wed, 18 May 2022 10:06:58 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 18 May 2022 16:06:43 +0200 Message-Id: <20220518140645.17144-2-ludo@gnu.org> X-Mailer: git-send-email 2.36.0 In-Reply-To: <20220518140645.17144-1-ludo@gnu.org> References: <87zgjkfbcl.fsf_-_@gnu.org> <20220518140645.17144-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1652883292; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=5oNpxbrIwIZb+aSMj+/70+ODt2DkhIRzOxZtB9OePY0=; b=SCHsdJI43eFvhkvPfsxyayO080VyixPhkuIYfE2RuhqCWfbdxtWiWlqz/GuS3+L0X6dfeT 3tiYpzbj0yjzXRRccIMMQ8vg410GQpmkNCU0a7LgvcHf+OCgs1J9mdDSZHLRPY27CFATt1 0hbT1UNf959MS6VD95rSX4Vij2XejNm4g5LuKYcJ+hvc7rLEvoz9lT/vpTmNGwzP2G3HY4 cUFpcUuebaLOZ+9f6xXNTrb42Jn/rBIMTeJKP5KyRgwmZYblcuiM7Hebf//7uyejK34KvN oDdQ+ESZE/CFmX6Vew9iGXzDGYMjgNyqZcqJixNiqthe6KHK7pRB8m2PnIkGrg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1652883292; a=rsa-sha256; cv=none; b=UFsKIKmP4dfEqB3Pvw6DjJIk7nR6nkKcwXAQLMVoCvxRL3Nsjs11iSXpkC+Ox8yKGsE7Cd CoO07bS/4nTjFhlRy0Vb9qa6VXZDiOEs6z1A0EEuIeASD5yQjrZc3lQzgMV+uhEww2Ph/A H4AH2qhfonGf4V073U28Ev7XZwLSGlUjmz1VeRNt3/77mV09lVhsyNcoAyAynPIf0qJmP1 xU3+RT22StoDZ8rN/EoXywZCmMFMrjKxrtozx+GDKcp137ANWrtvfx6+mjqeaVAqpZ6nWn z/5b8eIkMVWDI2/NSjeBvkdJE59ceP2b7KMNFzhLY25FJiVhwEYJLisWbST4fA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=lDQt8PL7; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "bug-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="bug-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -4.35 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=lDQt8PL7; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "bug-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="bug-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 2E0BE8810 X-Spam-Score: -4.35 X-Migadu-Scanner: scn0.migadu.com X-TUID: WmznkXmHGMDw * modules/shepherd/service.scm (endpoint->listening-socket) (open-sockets): New procedures. (make-inetd-constructor): Change 'address' parameter to 'endpoints'. Mark #:socket-style, #:socket-owner, #:socket-group, #:socket-directory-permissions, and #:listen-backlog as deprecated. [spawn-child-service, accept-clients]: Take 'server-address' parameter and use it. Update callers. Add compatibility later for when ENDPOINTS is an address. (make-inetd-destructor): Adjust. (make-systemd-destructor)[endpoint->listening-socket, open-sockets]: Remove. Adjust to new return value of 'open-sockets'. * NEWS: Mention it. --- NEWS | 13 ++ doc/shepherd.texi | 54 ++++---- modules/shepherd/service.scm | 255 +++++++++++++++++------------------ 3 files changed, 161 insertions(+), 161 deletions(-) diff --git a/NEWS b/NEWS index c51e8e2..4ce7a48 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,19 @@ Copyright © 2013-2014, 2016, 2018-2020, 2022 Ludovic Courtès Please send Shepherd bug reports to bug-guix@gnu.org. * Changes in version 0.9.1 +** ‘make-inetd-constructor’ now accepts a list of endpoints + +In 0.9.0, ‘make-inetd-constructor’ would take a single address as returned by +‘make-socket-address’. This was insufficiently flexible since it didn’t let +you have an inetd service with multiple endpoints. ‘make-inetd-constructor’ +now takes a list of endpoints, similar to what ‘make-systemd-constructor’ +already did. + +For compatibility with 0.9.0, if the second argument to +‘make-systemd-constructor’ is an address, it is automatically converted to a +list of endpoints. This behavior will be preserved for at least the whole +0.9.x series. + ** ‘shepherd’ reports whether a service is transient ** ‘herd status’ shows whether a service is transient ** Fix possible file descriptor leak in ‘make-inetd-constructor’ diff --git a/doc/shepherd.texi b/doc/shepherd.texi index 3d01186..9efc48e 100644 --- a/doc/shepherd.texi +++ b/doc/shepherd.texi @@ -1082,11 +1082,28 @@ services, specifically those in @code{nowait} mode where the daemon is passed the newly-accepted socket connection while @command{shepherd} is in charge of listening. -@deffn {procedure} make-inetd-constructor @var{command} @var{address} - [#:service-name-stem _] [#:requirements '()] @ - [#:socket-style SOCK_STREAM] [#:listen-backlog 10] @ +Listening endpoints for such services are described as records built +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] +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}. + +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. +@end deffn + +The inetd service constructor takes a command and a list of such +endpoints: + +@deffn {procedure} make-inetd-constructor @var{command} @var{endpoints} + [#:service-name-stem _] [#:requirements '()] @ [#:max-connections (default-inetd-max-connections)] @ [#:user #f] @ [#:group #f] @ @@ -1095,14 +1112,9 @@ in charge of listening. [#:file-creation-mask #f] [#:create-session? #t] @ [#:resource-limits '()] @ [#:environment-variables (default-environment-variables)] -Return a procedure that opens a socket listening to @var{address}, an -object as returned by @code{make-socket-address}, and accepting connections in -the background; the @var{listen-backlog} argument is passed to @var{accept}. - -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. +Return a procedure that opens sockets listening to @var{endpoints}, a list +of objects as returned by @code{endpoint}, and accepting connections in the +background. Upon a client connection, a transient service running @var{command} is spawned. Only up to @var{max-connections} simultaneous connections are @@ -1133,24 +1145,6 @@ environment (see below), which usually checks them using the libsystemd or libelogind @uref{https://www.freedesktop.org/software/systemd/man/sd_listen_fds.html, client library helper functions}. - -Listening endpoints for such services are described as records built -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] -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}. - -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. -@end deffn - The constructor and destructor for systemd-style daemons are described below. diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm index ded8283..e93466a 100644 --- a/modules/shepherd/service.scm +++ b/modules/shepherd/service.scm @@ -1225,6 +1225,90 @@ as argument, where SIGNAL defaults to `SIGTERM'." (lambda (ignored . args) (not (zero? (status:exit-val (system (apply string-append command))))))) + +;;; +;;; Server endpoints. +;;; + +;; Endpoint of a systemd-style or inetd-style service. +(define-record-type + (make-endpoint name address style backlog owner group permissions) + endpoint? + (name endpoint-name) ;string + (address endpoint-address) ;socket address + (style endpoint-style) ;SOCK_STREAM, etc. + (backlog endpoint-backlog) ;integer + (owner endpoint-socket-owner) ;integer + (group endpoint-socket-group) ;integer + (permissions endpoint-socket-directory-permissions)) ;integer + +(define* (endpoint address + #:key (name "unknown") (style SOCK_STREAM) + (backlog 128) + (socket-owner (getuid)) (socket-group (getgid)) + (socket-directory-permissions #o755)) + "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}. + +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." + (make-endpoint name address style backlog + socket-owner socket-group + socket-directory-permissions)) + +(define (endpoint->listening-socket endpoint) + "Return a listening socket for ENDPOINT." + (match endpoint + (($ name address style backlog + owner group permissions) + (let* ((sock (non-blocking-port + (socket (sockaddr:fam address) style 0))) + (owner (if (integer? owner) + owner + (passwd:uid (getpwnam owner)))) + (group (if (integer? group) + group + (group:gid (getgrnam group))))) + (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) + (when (= AF_UNIX (sockaddr:fam address)) + (mkdir-p (dirname (sockaddr:path address)) permissions) + (chown (dirname (sockaddr:path address)) owner group) + (catch-system-error (delete-file (sockaddr:path address)))) + + (bind sock address) + (listen sock backlog) + + (when (= AF_UNIX (sockaddr:fam address)) + (chown sock owner group) + (chmod sock #o666)) + + sock)))) + +(define (open-sockets endpoints) + "Return a list of listening sockets corresponding to ENDPOINTS, in the same +order as ENDPOINTS. If opening of binding one of them fails, an exception is +thrown an previously-opened sockets are closed." + (let loop ((endpoints endpoints) + (result '())) + (match endpoints + (() + (reverse result)) + ((head tail ...) + (let ((sock (catch 'system-error + (lambda () + (endpoint->listening-socket head)) + (lambda args + ;; When opening one socket fails, abort the whole + ;; process. + (for-each (match-lambda + ((_ . socket) (close-port socket))) + result) + (apply throw args))))) + (loop tail (cons sock result))))))) + ;;; ;;; Inetd-style services. @@ -1311,18 +1395,13 @@ as argument, where SIGNAL defaults to `SIGTERM'." ;; service. (make-parameter 100)) -(define* (make-inetd-constructor command address +(define* (make-inetd-constructor command endpoints #:key (service-name-stem (match command ((program . _) (basename program)))) (requirements '()) - (socket-style SOCK_STREAM) - (socket-owner (getuid)) - (socket-group (getgid)) - (socket-directory-permissions #o755) - (listen-backlog 10) (max-connections (default-inetd-max-connections)) (user #f) @@ -1333,15 +1412,17 @@ as argument, where SIGNAL defaults to `SIGTERM'." (create-session? #t) (environment-variables (default-environment-variables)) - (resource-limits '())) - "Return a procedure that opens a socket listening to @var{address}, an -object as returned by @code{make-socket-address}, and accepting connections in -the background; the @var{listen-backlog} argument is passed to @var{accept}. + (resource-limits '()) -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. + ;; Deprecated. + (socket-style SOCK_STREAM) + (socket-owner (getuid)) + (socket-group (getgid)) + (socket-directory-permissions #o755) + (listen-backlog 10)) + "Return a procedure that opens sockets listening to @var{endpoints}, a list +of objects as returned by @code{endpoint}, and accepting connections in the +background. Upon a client connection, a transient service running @var{command} is spawned. Only up to @var{max-connections} simultaneous connections are @@ -1370,7 +1451,7 @@ The remaining arguments are as for @code{make-forkexec-constructor}." connection-count (canonical-name service)) (default-service-termination-handler service status)) - (define (spawn-child-service connection client-address) + (define (spawn-child-service connection server-address client-address) (let* ((name (child-service-name)) (service (make #:provides (list name) @@ -1387,7 +1468,7 @@ The remaining arguments are as for @code{make-forkexec-constructor}." #:file-creation-mask file-creation-mask #:create-session? create-session? #:environment-variables - (append (inetd-variables address + (append (inetd-variables server-address client-address) environment-variables) #:resource-limits resource-limits) @@ -1396,7 +1477,7 @@ The remaining arguments are as for @code{make-forkexec-constructor}." (register-services service) (start service))) - (define (accept-clients sock) + (define (accept-clients server-address sock) ;; Return a thunk that accepts client connections from SOCK. (lambda () (let loop () @@ -1407,7 +1488,7 @@ The remaining arguments are as for @code{make-forkexec-constructor}." (local-output (l10n "Maximum number of ~a clients reached; \ rejecting connection from ~:[~a~;~*local process~].") - (socket-address->string address) + (socket-address->string server-address) (= AF_UNIX (sockaddr:fam client-address)) (socket-address->string client-address)) (close-port connection)) @@ -1415,46 +1496,35 @@ rejecting connection from ~:[~a~;~*local process~].") (set! connection-count (+ 1 connection-count)) (local-output (l10n "Accepted connection on ~a from ~:[~a~;~*local process~].") - (socket-address->string address) + (socket-address->string server-address) (= AF_UNIX (sockaddr:fam client-address)) (socket-address->string client-address)) - (spawn-child-service connection client-address))))) + (spawn-child-service connection + server-address client-address))))) (loop)))) (lambda args - (let ((owner (if (integer? socket-owner) - socket-owner - (passwd:uid (getpwnam socket-owner)))) - (group (if (integer? socket-group) - socket-group - (group:gid (getgrnam socket-group)))) - (sock (socket (sockaddr:fam address) socket-style 0))) - (catch #t - (lambda () - (non-blocking-port sock) - (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) - - (when (= AF_UNIX (sockaddr:fam address)) - (mkdir-p (dirname (sockaddr:path address)) - socket-directory-permissions) - (chown (dirname (sockaddr:path address)) owner group) - (catch-system-error (delete-file (sockaddr:path address)))) - (bind sock address) - (when (= AF_UNIX (sockaddr:fam address)) - (chown sock owner group) - (chmod sock #o666)) - - (listen sock listen-backlog) - (spawn-fiber (accept-clients sock)) - sock) - (lambda args - (close-port sock) - (apply throw args)))))) + (let* ((endpoints (match endpoints + (((? endpoint?) ...) endpoints) + (address (list (endpoint address + #:style socket-style + #:backlog listen-backlog + #:socket-owner socket-owner + #:socket-group socket-group + #:socket-directory-permissions + socket-directory-permissions))))) + (sockets (open-sockets endpoints))) + (for-each (lambda (endpoint socket) + (spawn-fiber + (accept-clients (endpoint-address endpoint) + socket))) + endpoints sockets) + sockets))) (define (make-inetd-destructor) "Return a procedure that terminates an inetd service." - (lambda (sock) - (close-port sock) + (lambda (sockets) + (for-each close-port sockets) #f)) @@ -1462,35 +1532,6 @@ rejecting connection from ~:[~a~;~*local process~].") ;;; systemd-style services. ;;; -;; Endpoint of a systemd-style service. -(define-record-type - (make-endpoint name address style backlog owner group permissions) - endpoint? - (name endpoint-name) ;string - (address endpoint-address) ;socket address - (style endpoint-style) ;SOCK_STREAM, etc. - (backlog endpoint-backlog) ;integer - (owner endpoint-socket-owner) ;integer - (group endpoint-socket-group) ;integer - (permissions endpoint-socket-directory-permissions)) ;integer - -(define* (endpoint address - #:key (name "unknown") (style SOCK_STREAM) - (backlog 128) - (socket-owner (getuid)) (socket-group (getgid)) - (socket-directory-permissions #o755)) - "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}. - -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." - (make-endpoint name address style backlog - socket-owner socket-group - socket-directory-permissions)) - (define (wait-for-readable ports) "Suspend the current task until one of @var{ports} is available for reading." @@ -1538,58 +1579,10 @@ The colon-separated list of endpoint names. This must be paired with @code{make-systemd-destructor}." (lambda args - (define (endpoint->listening-socket endpoint) - ;; Return a listening socket for ENDPOINT. - (match endpoint - (($ name address style backlog - owner group permissions) - (let* ((sock (non-blocking-port - (socket (sockaddr:fam address) style 0))) - (owner (if (integer? owner) - owner - (passwd:uid (getpwnam owner)))) - (group (if (integer? group) - group - (group:gid (getgrnam group))))) - (setsockopt sock SOL_SOCKET SO_REUSEADDR 1) - (when (= AF_UNIX (sockaddr:fam address)) - (mkdir-p (dirname (sockaddr:path address)) permissions) - (chown (dirname (sockaddr:path address)) owner group) - (catch-system-error (delete-file (sockaddr:path address)))) - - (bind sock address) - (listen sock backlog) - - (when (= AF_UNIX (sockaddr:fam address)) - (chown sock owner group) - (chmod sock #o666)) - - sock)))) - - (define (open-sockets addresses) - (let loop ((endpoints endpoints) - (result '())) - (match endpoints - (() - (reverse result)) - ((head tail ...) - (let ((sock (catch 'system-error - (lambda () - (endpoint->listening-socket head)) - (lambda args - ;; When opening one socket fails, abort the whole - ;; process. - (for-each (match-lambda - ((_ . socket) (close-port socket))) - result) - (apply throw args))))) - (loop tail - `((,(endpoint-name head) . ,sock) ,@result))))))) - - (let* ((sockets (open-sockets endpoints)) - (ports (match sockets - (((names . ports) ...) - ports))) + (let* ((ports (open-sockets endpoints)) + (sockets (map (lambda (endpoint socket) + (cons (endpoint-name endpoint) socket)) + endpoints ports)) (variables (list (string-append "LISTEN_FDS=" (number->string (length sockets))) (string-append "LISTEN_FDNAMES=" -- 2.36.0