diff options
Diffstat (limited to 'gnu/services.scm')
| -rw-r--r-- | gnu/services.scm | 51 |
1 files changed, 44 insertions, 7 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index ecf3532e52..8a66d453df 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -60,6 +60,7 @@ ambiguous-target-service-error-service ambiguous-target-service-error-target-type + system-service-type boot-service-type activation-service-type activation-service->script @@ -89,9 +90,10 @@ ;;; by providing one procedure to compose extensions, and one procedure to ;;; extend itself. ;;; -;;; A notable service type is BOOT-SERVICE-TYPE, which has a single instance, -;;; %BOOT-SERVICE. %BOOT-SERVICE constitutes the root of the service DAG. It -;;; produces the boot script that the initrd loads. +;;; A notable service type is SYSTEM-SERVICE-TYPE, which has a single +;;; instance, which is the root of the service DAG. Its value is the +;;; derivation that produces the 'system' directory as returned by +;;; 'operating-system-derivation'. ;;; ;;; The 'fold-services' procedure can be passed a list of procedures, which it ;;; "folds" by propagating extensions down the graph; it returns the root @@ -182,6 +184,25 @@ This is a shorthand for (map (lambda (svc) ...) %base-services)." ;;; Core services. ;;; +(define (system-derivation mentries mextensions) + "Return as a monadic value the derivation of the 'system' directory +containing the given entries." + (mlet %store-monad ((entries mentries) + (extensions (sequence %store-monad mextensions))) + (lower-object + (file-union "system" + (append entries (concatenate extensions)))))) + +(define system-service-type + ;; This is the ultimate service type, the root of the service DAG. The + ;; service of this type is extended by monadic name/item pairs. These items + ;; end up in the "system directory" as returned by + ;; 'operating-system-derivation'. + (service-type (name 'system) + (extensions '()) + (compose identity) + (extend system-derivation))) + (define (compute-boot-script _ mexps) (mlet %store-monad ((gexps (sequence %store-monad mexps))) (gexp->file "boot" @@ -203,17 +224,25 @@ This is a shorthand for (map (lambda (svc) ...) %base-services)." ;; Activate the system and spawn dmd. #$@gexps)))) +(define (boot-script-entry mboot) + "Return, as a monadic value, an entry for the boot script in the system +directory." + (mlet %store-monad ((boot mboot)) + (return `(("boot" ,boot))))) + (define boot-service-type ;; The service of this type is extended by being passed gexps as monadic ;; values. It aggregates them in a single script, as a monadic value, which ;; becomes its 'parameters'. It is the only service that extends nothing. (service-type (name 'boot) - (extensions '()) + (extensions + (list (service-extension system-service-type + boot-script-entry))) (compose append) (extend compute-boot-script))) (define %boot-service - ;; This is the ultimate service, the root of the service DAG. + ;; The service that produces the boot script. (service boot-service-type #t)) (define* (file-union name files) ;FIXME: Factorize. @@ -351,6 +380,12 @@ ACTIVATION-SCRIPT-TYPE." (define (files->etc-directory files) (file-union "etc" files)) +(define (etc-entry files) + "Return an entry for the /etc directory consisting of FILES in the system +directory." + (with-monad %store-monad + (return `(("etc" ,(files->etc-directory files)))))) + (define etc-service-type (service-type (name 'etc) (extensions @@ -359,7 +394,8 @@ ACTIVATION-SCRIPT-TYPE." (lambda (files) (let ((etc (files->etc-directory files))) - #~(activate-etc #$etc)))))) + #~(activate-etc #$etc)))) + (service-extension system-service-type etc-entry))) (compose concatenate) (extend append))) @@ -450,7 +486,8 @@ kernel." (lambda (node) (reverse (vhash-foldq* cons '() node edges))))) -(define* (fold-services services #:key (target-type boot-service-type)) +(define* (fold-services services + #:key (target-type system-service-type)) "Fold SERVICES by propagating their extensions down to the root of type TARGET-TYPE; return the root service adjusted accordingly." (define dependents |