From 2d2651e7813a232e1e49e8aa0d0e267dd9dd1f18 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 24 Nov 2015 22:29:47 +0100
Subject: services: dmd: Error out upon unmet dmd requirements.

* gnu/services/dmd.scm (assert-no-duplicates): Rename to...
(assert-valid-graph): ... this.
[provisions]: New variable.
[assert-satisfied-requirements]: New procedure.
Use it.
* tests/guix-system.sh: Add test with unmet dmd requirements.
---
 gnu/services/dmd.scm | 58 ++++++++++++++++++++++++++++++++++++----------------
 tests/guix-system.sh | 49 ++++++++++++++++++++++++++++++++++++--------
 2 files changed, 81 insertions(+), 26 deletions(-)

diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index e87b9e4415..80dee4fb18 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -116,25 +116,47 @@ (define-record-type* <dmd-service>
                  (default #t)))
 
 
-(define (assert-no-duplicates services)
-  "Raise an error if SERVICES provide the same dmd service more than once.
+(define (assert-valid-graph services)
+  "Raise an error if SERVICES does not define a valid dmd service graph, for
+instance if a service requires a nonexistent service, or if more than one
+service uses a given name.
 
-This is a constraint that dmd's 'register-service' verifies but we'd better
-verify it here statically than wait until PID 1 halts with an assertion
+These are constraints that dmd's 'register-service' verifies but we'd better
+verify them here statically than wait until PID 1 halts with an assertion
 failure."
-  (fold (lambda (service set)
-          (define (assert-unique symbol)
-            (when (set-contains? set symbol)
-              (raise (condition
-                      (&message
-                       (message
-                        (format #f (_ "service '~a' provided more than once")
-                                symbol)))))))
-
-          (for-each assert-unique (dmd-service-provision service))
-          (fold set-insert set (dmd-service-provision service)))
-        (setq)
-        services))
+  (define provisions
+    ;; The set of provisions (symbols).  Bail out if a symbol is given more
+    ;; than once.
+    (fold (lambda (service set)
+            (define (assert-unique symbol)
+              (when (set-contains? set symbol)
+                (raise (condition
+                        (&message
+                         (message
+                          (format #f (_ "service '~a' provided more than once")
+                                  symbol)))))))
+
+            (for-each assert-unique (dmd-service-provision service))
+            (fold set-insert set (dmd-service-provision service)))
+          (setq 'dmd)
+          services))
+
+  (define (assert-satisfied-requirements service)
+    ;; Bail out if the requirements of SERVICE aren't satisfied.
+    (for-each (lambda (requirement)
+                (unless (set-contains? provisions requirement)
+                  (raise (condition
+                          (&message
+                           (message
+                            (format #f (_ "service '~a' requires '~a', \
+which is undefined")
+                                    (match (dmd-service-provision service)
+                                      ((head . _) head)
+                                      (_          service))
+                                    requirement)))))))
+              (dmd-service-requirement service)))
+
+  (for-each assert-satisfied-requirements services))
 
 (define (dmd-configuration-file services)
   "Return the dmd configuration file for SERVICES."
@@ -144,7 +166,7 @@ (define modules
       (gnu build file-systems)
       (guix build utils)))
 
-  (assert-no-duplicates services)
+  (assert-valid-graph services)
 
   (mlet %store-monad ((modules  (imported-modules modules))
                       (compiled (compiled-modules modules)))
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index d99c9bd07b..e20bc98713 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -71,13 +71,7 @@ else
     grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile"
 fi
 
-# Reporting of duplicate service identifiers.
-
-cat > "$tmpfile" <<EOF
-(use-modules (gnu))
-(use-service-modules networking)
-
-(operating-system
+OS_BASE='
   (host-name "antelope")
   (timezone "Europe/Paris")
   (locale "en_US.UTF-8")
@@ -85,11 +79,20 @@ cat > "$tmpfile" <<EOF
   (bootloader (grub-configuration (device "/dev/sdX")))
   (file-systems (cons (file-system
                         (device "root")
-                        (title 'label)
+                        (title (string->symbol "label"))
                         (mount-point "/")
                         (type "ext4"))
                       %base-file-systems))
+'
 
+# Reporting of duplicate service identifiers.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu))
+(use-service-modules networking)
+
+(operating-system
+  $OS_BASE
   (services (cons* (dhcp-client-service)
                    (dhcp-client-service) ;twice!
                    %base-services)))
@@ -103,6 +106,36 @@ else
     grep "service 'networking'.*more than once" "$errorfile"
 fi
 
+# Reporting unmet dmd requirements.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu) (gnu services dmd))
+(use-service-modules networking)
+
+(define buggy-service-type
+  (dmd-service-type
+    'buggy
+    (lambda _
+      (dmd-service
+        (provision '(buggy!))
+        (requirement '(does-not-exist))
+        (start #t)))))
+
+(operating-system
+  $OS_BASE
+  (services (cons (service buggy-service-type #t)
+                  %base-services)))
+EOF
+
+if guix system build "$tmpfile" 2> "$errorfile"
+then
+    exit 1
+else
+    grep "service 'buggy!'.*'does-not-exist'.*undefined" "$errorfile"
+fi
+
+# Reporting inconsistent user accounts.
+
 make_user_config ()
 {
     cat > "$tmpfile" <<EOF
-- 
cgit v1.2.3