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 @@ (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)))))))
(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)
services))
(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)))

View file

@ -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