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)))
|
||||
|
||||
|
||||
(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 @@ 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)))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue