01/02: services: dmd: Error out upon unmet dmd requirements.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 2d2651e7813a232e1e49e8aa0d0e267dd9dd1f18
Author: Ludovic Courtès <address@hidden>
Date:   Tue Nov 24 22:29:47 2015 +0100

    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 e87b9e4..80dee4f 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -116,25 +116,47 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing 
else."
                  (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 @@ failure."
       (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 d99c9bd..e20bc98 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