From 2d2651e7813a232e1e49e8aa0d0e267dd9dd1f18 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 24 Nov 2015 22:29:47 +0100 Subject: 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 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 18 deletions(-) (limited to 'gnu/services/dmd.scm') diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index e87b9e4415..80dee4fb18 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))) -- cgit v1.2.3 From fae685b9cc21860d84dc5a768795025376b7db06 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Nov 2015 10:46:02 +0100 Subject: services: dmd: Add 'modules' and 'imported-modules' fields. * gnu/services/dmd.scm (%default-imported-modules, %default-modules): New variables. * gnu/services/dmd.scm ()[modules, imported-modules]: New field. * gnu/services/dmd.scm (dmd-service-file-name, dmd-service-file): New procedures. (dmd-configuration-file)[modules]: Compute based on the 'imported-modules' field of SERVICES. (dmd-configuration-file): Remove 'use-modules' form. Use 'dmd-service-file', and call 'primitive-load' on each file. * doc/guix.texi (dmd Services): Document the new fields. --- doc/guix.texi | 9 ++++++ gnu/services/dmd.scm | 83 +++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 68 insertions(+), 24 deletions(-) (limited to 'gnu/services/dmd.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 5eb6720934..240b5d1ccd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8068,6 +8068,15 @@ deco doc @var{service-name} where @var{service-name} is one of the symbols in @var{provision} (@pxref{Invoking deco,,, dmd, GNU dmd Manual}). + +@item @code{modules} (default: @var{%default-modules}) +This is the list of modules that must be in scope when @code{start} and +@code{stop} are evaluated. + +@item @code{imported-modules} (default: @var{%default-imported-modules}) +This is the list of modules to import in the execution environment of +dmd. + @end table @end deftp diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 80dee4fb18..76f286a672 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -45,6 +45,11 @@ dmd-service-start dmd-service-stop dmd-service-auto-start? + dmd-service-modules + dmd-service-imported-modules + + %default-imported-modules + %default-modules dmd-service-back-edges)) @@ -99,6 +104,22 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else." (list (service-extension dmd-root-service-type (compose list proc)))))) +(define %default-imported-modules + ;; Default set of modules imported for a service's consumption. + '((guix build utils) + (guix build syscalls) + (gnu build file-systems))) + +(define %default-modules + ;; Default set of modules visible in a service's file. + `((dmd service) + (oop goops) + (ice-9 ftw) + (guix build utils) + (guix build syscalls) + ((gnu build file-systems) + #:select (check-file-system canonicalize-device-spec)))) + (define-record-type* dmd-service make-dmd-service dmd-service? @@ -113,7 +134,11 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else." (stop dmd-service-stop ;g-expression (procedure) (default #~(const #f))) (auto-start? dmd-service-auto-start? ;Boolean - (default #t))) + (default #t)) + (modules dmd-service-modules ;list of module names + (default %default-modules)) + (imported-modules dmd-service-imported-modules ;list of module names + (default %default-imported-modules))) (define (assert-valid-graph services) @@ -158,41 +183,51 @@ which is undefined") (for-each assert-satisfied-requirements services)) +(define (dmd-service-file-name service) + "Return the file name where the initialization code for SERVICE is to be +stored." + (let ((provisions (string-join (map symbol->string + (dmd-service-provision service))))) + (string-append "dmd-" + (string-map (match-lambda + (#\/ #\-) + (chr chr)) + provisions) + ".scm"))) + +(define (dmd-service-file service) + "Return a file defining SERVICE." + (gexp->file (dmd-service-file-name service) + #~(begin + (use-modules #$@(dmd-service-modules service)) + + (make + #:docstring '#$(dmd-service-documentation service) + #:provides '#$(dmd-service-provision service) + #:requires '#$(dmd-service-requirement service) + #:respawn? '#$(dmd-service-respawn? service) + #:start #$(dmd-service-start service) + #:stop #$(dmd-service-stop service))))) + (define (dmd-configuration-file services) "Return the dmd configuration file for SERVICES." (define modules - ;; Extra modules visible to dmd.conf. - '((guix build syscalls) - (gnu build file-systems) - (guix build utils))) + (delete-duplicates + (append-map dmd-service-imported-modules services))) (assert-valid-graph services) (mlet %store-monad ((modules (imported-modules modules)) - (compiled (compiled-modules modules))) + (compiled (compiled-modules modules)) + (files (mapm %store-monad dmd-service-file services))) (define config #~(begin (eval-when (expand load eval) (set! %load-path (cons #$modules %load-path)) (set! %load-compiled-path - (cons #$compiled %load-compiled-path))) - - (use-modules (ice-9 ftw) - (guix build syscalls) - (guix build utils) - ((gnu build file-systems) - #:select (check-file-system canonicalize-device-spec))) - - (register-services - #$@(map (lambda (service) - #~(make - #:docstring '#$(dmd-service-documentation service) - #:provides '#$(dmd-service-provision service) - #:requires '#$(dmd-service-requirement service) - #:respawn? '#$(dmd-service-respawn? service) - #:start #$(dmd-service-start service) - #:stop #$(dmd-service-stop service))) - services)) + (cons #$compiled %load-compiled-path))) + + (apply register-services (map primitive-load '#$files)) ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it. (setenv "PATH" "/run/current-system/profile/bin") -- cgit v1.2.3 From 479b417b54ab5ef7ce0d46c409ab084d5eb3c9ad Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Nov 2015 10:59:58 +0100 Subject: services: dmd: Strip the default list of modules. * gnu/services/dmd.scm (%default-imported-modules): Remove (gnu build file-systems). (%default-modules): Likewise, and remove (ice-9 ftw). * gnu/services/base.scm (file-system-service-type): Add 'modules' and 'imported-modules' fields. --- gnu/services/base.scm | 9 ++++++++- gnu/services/dmd.scm | 8 ++------ 2 files changed, 10 insertions(+), 7 deletions(-) (limited to 'gnu/services/dmd.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 6077fb6272..c242c7dbb8 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -223,7 +223,14 @@ FILE-SYSTEM." (chdir "/") (umount #$target) - #f))))))) + #f)) + + ;; We need an additional module. + (modules `(((gnu build file-systems) + #:select (check-file-system canonicalize-device-spec)) + ,@%default-modules)) + (imported-modules `((gnu build file-systems) + ,@%default-imported-modules))))))) (define* (file-system-service file-system) "Return a service that mounts @var{file-system}, a @code{} diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 76f286a672..6f70f3d79b 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -107,18 +107,14 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else." (define %default-imported-modules ;; Default set of modules imported for a service's consumption. '((guix build utils) - (guix build syscalls) - (gnu build file-systems))) + (guix build syscalls))) (define %default-modules ;; Default set of modules visible in a service's file. `((dmd service) (oop goops) - (ice-9 ftw) (guix build utils) - (guix build syscalls) - ((gnu build file-systems) - #:select (check-file-system canonicalize-device-spec)))) + (guix build syscalls))) (define-record-type* dmd-service make-dmd-service -- cgit v1.2.3 From b9c7ed71b1c4110c3c8580f1bb8050c31324fa6a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Nov 2015 11:57:56 +0100 Subject: services: dmd: Spawn a REPL upon failure to load a service definition. Fixes . Reported by Mark H Weaver . * gnu/services/dmd.scm (dmd-configuration-file)[config]: Wrap 'primitive-load' calls in 'call-with-error-handling'. --- gnu/services/dmd.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'gnu/services/dmd.scm') diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 6f70f3d79b..545087acc9 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -223,7 +223,13 @@ stored." (set! %load-compiled-path (cons #$compiled %load-compiled-path))) - (apply register-services (map primitive-load '#$files)) + (use-modules (system repl error-handling)) + + ;; Arrange to spawn a REPL if loading one of FILES fails. This is + ;; better than a kernel panic. + (call-with-error-handling + (lambda () + (apply register-services (map primitive-load '#$files)))) ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it. (setenv "PATH" "/run/current-system/profile/bin") -- cgit v1.2.3