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:
parent
eb31d4b4f1
commit
2d2651e781
|
@ -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)))
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue