From 0a9e82b43080275a2755624f3208287056dc9f95 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Thu, 17 Mar 2022 14:31:21 -0400
Subject: services: nfs: Define rpcbind-shepherd-service at the top level.

Attempting to use the 'nfs-service-type' as part of a computed
operating-system definition, the following exception would be thrown:

  ice-9/boot-9.scm:1685:16: In procedure raise-exception:
  ERROR:
    1. &ambiguous-target-service-error:
        service: #<<service> type: #<service-type rpcbind 7f7529853780> value: #<<rpcbind-configuration> rpcbind: #<package rpcbind@1.2.6 gnu/packages/onc-rpc.scm:87 7f75389e78f0> warm-start?: #t>>
        target-type: #<service-type shepherd-root 7f7529396080>
    2. &message: "more than one target service of type 'shepherd-root'"

The problem was that the rpcbind shepherd-service object was dynamically
instantiated every time the rpcbind-service-type would be called, causing
multiple objects in some situations, resulting in the above condition.

* gnu/services/nfs.scm (rpcbind-service-type): Refactor and adjust in a way to
extract...
(rpcbind-shepherd-service): ... this new procedure.
---
 gnu/services/nfs.scm | 60 +++++++++++++++++++++++++---------------------------
 1 file changed, 29 insertions(+), 31 deletions(-)

(limited to 'gnu/services/nfs.scm')

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 0d1617354e..78bf45f336 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -62,37 +62,35 @@ (define-record-type* <rpcbind-configuration>
   (warm-start?         rpcbind-configuration-warm-start?
                        (default #t)))
 
-(define rpcbind-service-type
-  (let ((proc
-         (lambda (config)
-           (define rpcbind
-             (rpcbind-configuration-rpcbind config))
-
-           (define rpcbind-command
-             #~(list (string-append #$rpcbind "/sbin/rpcbind") "-f"
-                     #$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
-
-           (shepherd-service
-            (documentation "Start the RPC bind daemon.")
-            (requirement '(networking))
-            (provision '(rpcbind-daemon))
+(define (rpcbind-shepherd-service config)
+  (let ((rpcbind (file-append (rpcbind-configuration-rpcbind config)
+                              "/sbin/rpcbind")))
+    (shepherd-service
+     (documentation "Start the RPC bind daemon.")
+     (requirement '(networking))
+     (provision '(rpcbind-daemon))
+     (start #~(make-forkexec-constructor
+               (list #$rpcbind "-f"
+                     #$@(if (rpcbind-configuration-warm-start? config)
+                            '("-w")
+                            '()))))
+     (stop #~(make-kill-destructor)))))
 
-            (start #~(make-forkexec-constructor #$rpcbind-command))
-            (stop #~(make-kill-destructor))))))
-    (service-type
-     (name 'rpcbind)
-     (extensions
-      (list (service-extension shepherd-root-service-type
-                               (compose list proc))))
-     ;; We use the extensions feature to allow other services to automatically
-     ;; configure and start this service.  Only one value can be provided.  We
-     ;; override it with the value returned by the extending service.
-     (compose identity)
-     (extend (lambda (config values)
-               (match values
-                 ((first . rest) first)
-                 (_ config))))
-     (default-value (rpcbind-configuration)))))
+(define rpcbind-service-type
+  (service-type
+   (name 'rpcbind)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             (compose list rpcbind-shepherd-service))))
+   ;; We use the extensions feature to allow other services to automatically
+   ;; configure and start this service.  Only one value can be provided.  We
+   ;; override it with the value returned by the extending service.
+   (compose identity)
+   (extend (lambda (config values)
+             (match values
+               ((first . rest) first)
+               (_ config))))
+   (default-value (rpcbind-configuration))))
 
 
 
-- 
cgit v1.2.3