diff options
Diffstat (limited to 'gnu/services/shepherd.scm')
| -rw-r--r-- | gnu/services/shepherd.scm | 149 |
1 files changed, 76 insertions, 73 deletions
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index ccb71f35e1..36ed9eb1c0 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -32,26 +32,26 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:export (dmd-root-service-type - %dmd-root-service - dmd-service-type - - dmd-service - dmd-service? - dmd-service-documentation - dmd-service-provision - dmd-service-requirement - dmd-service-respawn? - dmd-service-start - dmd-service-stop - dmd-service-auto-start? - dmd-service-modules - dmd-service-imported-modules + #:export (shepherd-root-service-type + %shepherd-root-service + shepherd-service-type + + shepherd-service + shepherd-service? + shepherd-service-documentation + shepherd-service-provision + shepherd-service-requirement + shepherd-service-respawn? + shepherd-service-start + shepherd-service-stop + shepherd-service-auto-start? + shepherd-service-modules + shepherd-service-imported-modules %default-imported-modules %default-modules - dmd-service-back-edges)) + shepherd-service-back-edges)) ;;; Commentary: ;;; @@ -60,7 +60,7 @@ ;;; Code: -(define (dmd-boot-gexp services) +(define (shepherd-boot-gexp services) (mlet %store-monad ((shepherd-conf (shepherd-configuration-file services))) (return #~(begin ;; Keep track of the booted system. @@ -81,29 +81,30 @@ (execl (string-append #$shepherd "/bin/shepherd") "shepherd" "--config" #$shepherd-conf))))) -(define dmd-root-service-type +(define shepherd-root-service-type (service-type - (name 'dmd-root) - ;; Extending the root dmd service (aka. PID 1) happens by concatenating the - ;; list of services provided by the extensions. + (name 'shepherd-root) + ;; Extending the root shepherd service (aka. PID 1) happens by + ;; concatenating the list of services provided by the extensions. (compose concatenate) (extend append) - (extensions (list (service-extension boot-service-type dmd-boot-gexp) + (extensions (list (service-extension boot-service-type + shepherd-boot-gexp) (service-extension profile-service-type (const (list shepherd))))))) -(define %dmd-root-service - ;; The root dmd service, aka. PID 1. Its parameter is a list of - ;; <dmd-service> objects. - (service dmd-root-service-type '())) +(define %shepherd-root-service + ;; The root shepherd service, aka. PID 1. Its parameter is a list of + ;; <shepherd-service> objects. + (service shepherd-root-service-type '())) -(define-syntax-rule (dmd-service-type service-name proc) - "Return a <service-type> denoting a simple dmd service--i.e., the type for a -service that extends DMD-ROOT-SERVICE-TYPE and nothing else." +(define-syntax-rule (shepherd-service-type service-name proc) + "Return a <service-type> denoting a simple shepherd service--i.e., the type +for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else." (service-type (name service-name) (extensions - (list (service-extension dmd-root-service-type + (list (service-extension shepherd-root-service-type (compose list proc)))))) (define %default-imported-modules @@ -118,35 +119,35 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else." (guix build utils) (guix build syscalls))) -(define-record-type* <dmd-service> - dmd-service make-dmd-service - dmd-service? - (documentation dmd-service-documentation ;string +(define-record-type* <shepherd-service> + shepherd-service make-shepherd-service + shepherd-service? + (documentation shepherd-service-documentation ;string (default "[No documentation.]")) - (provision dmd-service-provision) ;list of symbols - (requirement dmd-service-requirement ;list of symbols + (provision shepherd-service-provision) ;list of symbols + (requirement shepherd-service-requirement ;list of symbols (default '())) - (respawn? dmd-service-respawn? ;Boolean + (respawn? shepherd-service-respawn? ;Boolean (default #t)) - (start dmd-service-start) ;g-expression (procedure) - (stop dmd-service-stop ;g-expression (procedure) + (start shepherd-service-start) ;g-expression (procedure) + (stop shepherd-service-stop ;g-expression (procedure) (default #~(const #f))) - (auto-start? dmd-service-auto-start? ;Boolean + (auto-start? shepherd-service-auto-start? ;Boolean (default #t)) - (modules dmd-service-modules ;list of module names + (modules shepherd-service-modules ;list of module names (default %default-modules)) - (imported-modules dmd-service-imported-modules ;list of module names + (imported-modules shepherd-service-imported-modules ;list of module names (default %default-imported-modules))) (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 + "Raise an error if SERVICES does not define a valid shepherd service graph, +for instance if a service requires a nonexistent service, or if more than one service uses a given name. -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." +These are constraints that shepherd's 'register-service' verifies but we'd +better verify them here statically than wait until PID 1 halts with an +assertion failure." (define provisions ;; The set of provisions (symbols). Bail out if a symbol is given more ;; than once. @@ -159,9 +160,9 @@ failure." (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) + (for-each assert-unique (shepherd-service-provision service)) + (fold set-insert set (shepherd-service-provision service))) + (setq 'shepherd) services)) (define (assert-satisfied-requirements service) @@ -173,51 +174,53 @@ failure." (message (format #f (_ "service '~a' requires '~a', \ which is undefined") - (match (dmd-service-provision service) + (match (shepherd-service-provision service) ((head . _) head) (_ service)) requirement))))))) - (dmd-service-requirement service))) + (shepherd-service-requirement service))) (for-each assert-satisfied-requirements services)) -(define (dmd-service-file-name service) +(define (shepherd-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-" + (shepherd-service-provision service))))) + (string-append "shepherd-" (string-map (match-lambda (#\/ #\-) (chr chr)) provisions) ".scm"))) -(define (dmd-service-file service) +(define (shepherd-service-file service) "Return a file defining SERVICE." - (gexp->file (dmd-service-file-name service) + (gexp->file (shepherd-service-file-name service) #~(begin - (use-modules #$@(dmd-service-modules service)) + (use-modules #$@(shepherd-service-modules service)) (make <service> - #: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))))) + #:docstring '#$(shepherd-service-documentation service) + #:provides '#$(shepherd-service-provision service) + #:requires '#$(shepherd-service-requirement service) + #:respawn? '#$(shepherd-service-respawn? service) + #:start #$(shepherd-service-start service) + #:stop #$(shepherd-service-stop service))))) (define (shepherd-configuration-file services) "Return the shepherd configuration file for SERVICES." (define modules (delete-duplicates - (append-map dmd-service-imported-modules services))) + (append-map shepherd-service-imported-modules services))) (assert-valid-graph services) (mlet %store-monad ((modules (imported-modules modules)) (compiled (compiled-modules modules)) - (files (mapm %store-monad dmd-service-file services))) + (files (mapm %store-monad + shepherd-service-file + services))) (define config #~(begin (eval-when (expand load eval) @@ -238,20 +241,20 @@ stored." (format #t "starting services...~%") (for-each start - '#$(append-map dmd-service-provision - (filter dmd-service-auto-start? + '#$(append-map shepherd-service-provision + (filter shepherd-service-auto-start? services))))) (gexp->file "shepherd.conf" config))) -(define (dmd-service-back-edges services) - "Return a procedure that, when given a <dmd-service> from SERVICES, returns -the list of <dmd-service> that depend on it." +(define (shepherd-service-back-edges services) + "Return a procedure that, when given a <shepherd-service> from SERVICES, +returns the list of <shepherd-service> that depend on it." (define provision->service (let ((services (fold (lambda (service result) (fold (cut vhash-consq <> service <>) result - (dmd-service-provision service))) + (shepherd-service-provision service))) vlist-null services))) (lambda (name) @@ -265,7 +268,7 @@ the list of <dmd-service> that depend on it." (vhash-consq (provision->service requirement) service edges)) edges - (dmd-service-requirement service))) + (shepherd-service-requirement service))) vlist-null services)) |