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.
This commit is contained in:
Ludovic Courtès 2015-11-24 22:29:47 +01:00
parent eb31d4b4f1
commit 2d2651e781
2 changed files with 80 additions and 25 deletions

View File

@ -116,25 +116,47 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else."
(default #t))) (default #t)))
(define (assert-no-duplicates services) (define (assert-valid-graph services)
"Raise an error if SERVICES provide the same dmd service more than once. "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 These are constraints that dmd's 'register-service' verifies but we'd better
verify it here statically than wait until PID 1 halts with an assertion verify them here statically than wait until PID 1 halts with an assertion
failure." failure."
(fold (lambda (service set) (define provisions
(define (assert-unique symbol) ;; The set of provisions (symbols). Bail out if a symbol is given more
(when (set-contains? set symbol) ;; than once.
(raise (condition (fold (lambda (service set)
(&message (define (assert-unique symbol)
(message (when (set-contains? set symbol)
(format #f (_ "service '~a' provided more than once") (raise (condition
symbol))))))) (&message
(message
(format #f (_ "service '~a' provided more than once")
symbol)))))))
(for-each assert-unique (dmd-service-provision service)) (for-each assert-unique (dmd-service-provision service))
(fold set-insert set (dmd-service-provision service))) (fold set-insert set (dmd-service-provision service)))
(setq) (setq 'dmd)
services)) 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) (define (dmd-configuration-file services)
"Return the dmd configuration file for SERVICES." "Return the dmd configuration file for SERVICES."
@ -144,7 +166,7 @@ failure."
(gnu build file-systems) (gnu build file-systems)
(guix build utils))) (guix build utils)))
(assert-no-duplicates services) (assert-valid-graph services)
(mlet %store-monad ((modules (imported-modules modules)) (mlet %store-monad ((modules (imported-modules modules))
(compiled (compiled-modules modules))) (compiled (compiled-modules modules)))

View File

@ -71,13 +71,7 @@ else
grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile" grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile"
fi fi
# Reporting of duplicate service identifiers. OS_BASE='
cat > "$tmpfile" <<EOF
(use-modules (gnu))
(use-service-modules networking)
(operating-system
(host-name "antelope") (host-name "antelope")
(timezone "Europe/Paris") (timezone "Europe/Paris")
(locale "en_US.UTF-8") (locale "en_US.UTF-8")
@ -85,11 +79,20 @@ cat > "$tmpfile" <<EOF
(bootloader (grub-configuration (device "/dev/sdX"))) (bootloader (grub-configuration (device "/dev/sdX")))
(file-systems (cons (file-system (file-systems (cons (file-system
(device "root") (device "root")
(title 'label) (title (string->symbol "label"))
(mount-point "/") (mount-point "/")
(type "ext4")) (type "ext4"))
%base-file-systems)) %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) (services (cons* (dhcp-client-service)
(dhcp-client-service) ;twice! (dhcp-client-service) ;twice!
%base-services))) %base-services)))
@ -103,6 +106,36 @@ else
grep "service 'networking'.*more than once" "$errorfile" grep "service 'networking'.*more than once" "$errorfile"
fi 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 () make_user_config ()
{ {
cat > "$tmpfile" <<EOF cat > "$tmpfile" <<EOF