[bug#54997] [PATCH 07/12] services: bitlbee: Use 'make-inetd-constructor'.

[Ludovic Courtès]

* gnu/services/messaging.scm (bitlbee-shepherd-service): Add call to
'least-authority-wrapper'.  In 'start' method, use
'make-inetd-constructor' when available.
* gnu/tests/messaging.scm (run-bitlbee-test)["valid PID"]: Remove test.
---
 gnu/services/messaging.scm | 63 ++++++++++++++++++++++++++++----------
 gnu/tests/messaging.scm    | 21 +------------
 2 files changed, 48 insertions(+), 36 deletions(-)

diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 4bceb1d37a..7fdd8cf285 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Pierre-Antoine Rouby <contact@parouby.fr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -28,11 +28,14 @@ (define-module (gnu services messaging)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services configuration)
   #:use-module (gnu system shadow)
+  #:autoload   (gnu build linux-container) (%namespaces)
+  #:use-module ((gnu system file-systems) #:select (file-system-mapping))
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix deprecation)
+  #:use-module (guix least-authority)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
@@ -821,7 +824,18 @@ (define bitlbee-shepherd-service
   DaemonInterface = " interface "
   DaemonPort = " (number->string port) "
   PluginDir = " plugins "/lib/bitlbee
-" extra-settings)))
+" extra-settings))
+            (bitlbee* (least-authority-wrapper
+                       (file-append bitlbee "/sbin/bitlbee")
+                       #:name "bitlbee"
+                       #:mappings (list (file-system-mapping
+                                         (source "/var/lib/bitlbee")
+                                         (target source)
+                                         (writable? #t))
+                                        (file-system-mapping
+                                         (source conf)
+                                         (target conf)))
+                       #:namespaces (delq 'net %namespaces))))
 
        (with-imported-modules (source-module-closure
                                '((gnu build shepherd)
@@ -836,20 +850,37 @@ (define bitlbee-shepherd-service
 
                 (modules '((gnu build shepherd)
                            (gnu system file-systems)))
-                (start #~(make-forkexec-constructor/container
-                          (list #$(file-append bitlbee "/sbin/bitlbee")
-                                "-n" "-F" "-u" "bitlbee" "-c" #$conf)
-
-                          ;; Allow 'bitlbee-purple' to use libpurple plugins.
-                          #:environment-variables
-                          (list (string-append "PURPLE_PLUGIN_PATH="
-                                               #$plugins "/lib/purple-2"))
-
-                          #:pid-file "/var/run/bitlbee.pid"
-                          #:mappings (list (file-system-mapping
-                                            (source "/var/lib/bitlbee")
-                                            (target source)
-                                            (writable? #t)))))
+                (start #~(if (defined? 'make-inetd-constructor)
+
+                             (make-inetd-constructor
+                              (list #$bitlbee* "-I"
+                                    "-u" "bitlbee" "-c" #$conf)
+                              (addrinfo:addr
+                               (car (getaddrinfo #$interface
+                                                 #$(number->string port)
+                                                 (logior AI_NUMERICHOST
+                                                         AI_NUMERICSERV))))
+                              #:service-name-stem "bitlbee"
+
+                              ;; Allow 'bitlbee-purple' to use libpurple 
plugins.
+                              #:environment-variables
+                              (list (string-append "PURPLE_PLUGIN_PATH="
+                                                   #$plugins "/lib/purple-2")))
+
+                             (make-forkexec-constructor/container
+                              (list #$(file-append bitlbee "/sbin/bitlbee")
+                                    "-n" "-F" "-u" "bitlbee" "-c" #$conf)
+
+                              ;; Allow 'bitlbee-purple' to use libpurple 
plugins.
+                              #:environment-variables
+                              (list (string-append "PURPLE_PLUGIN_PATH="
+                                                   #$plugins "/lib/purple-2"))
+
+                              #:pid-file "/var/run/bitlbee.pid"
+                              #:mappings (list (file-system-mapping
+                                                (source "/var/lib/bitlbee")
+                                                (target source)
+                                                (writable? #t))))))
                 (stop  #~(make-kill-destructor)))))))))
 
 (define %bitlbee-accounts
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index 202a1c2f73..1e26c0ddea 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
-;;; Copyright © 2017, 2018, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017-2018, 2021-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -198,25 +198,6 @@ (define marionette
                 (start-service 'bitlbee))
              marionette))
 
-          (test-equal "valid PID"
-            #$(file-append bitlbee "/sbin/bitlbee")
-            (marionette-eval
-             '(begin
-                (use-modules (srfi srfi-1)
-                             (gnu services herd))
-
-                (let ((bitlbee
-                       (find (lambda (service)
-                               (equal? '(bitlbee)
-                                       (live-service-provision service)))
-                             (current-services))))
-                  (and (pk 'bitlbee-service bitlbee)
-                       (let ((pid (live-service-running bitlbee)))
-                         (readlink (string-append "/proc/"
-                                                  (number->string pid)
-                                                  "/exe"))))))
-             marionette))
-
           (test-assert "connect"
             (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK
                                                  6667))
-- 
2.35.1