summaryrefslogtreecommitdiff
path: root/gnu/services.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-02 18:44:17 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-02 22:25:11 +0100
commitd62e201cfd0f1e48c14586489d0e2b80ce943d4f (patch)
treed6c4989b36b54f154f21363ac72bd9896729f2de /gnu/services.scm
parent3a391e68dafe81560d3e4936a1ec5ac3b06d43bb (diff)
services: Add 'system-service-type'.
* gnu/services.scm (system-derivation): New procedure. (system-service-type): New variable. (boot-script-entry): New procedure. (boot-service-type): Extend SYSTEM-SERVICE-TYPE. (etc-entry): New procedure. (etc-service-type): Extend SYSTEM-SERVICE-TYPE. (fold-services): Change default #:target-type to SYSTEM-SERVICE-TYPE. * gnu/system.scm (operating-system-directory-base-entries): New procedure. (essential-services): Use it. Add an instance of SYSTEM-SERVICE-TYPE. (operating-system-boot-script): Pass #:target-type to 'fold-services'. (operating-system-derivation): Rewrite in terms of 'fold-services'. * gnu/system/linux-container.scm (system-container): Remove. (container-script): Use 'operating-system-derivation'. * guix/scripts/system.scm (export-extension-graph): Replace BOOT-SERVICE-TYPE by SYSTEM-SERVICE-TYPE. * doc/images/service-graph.dot: Add 'system' node and edges. * doc/guix.texi (Service Composition): Mention SYSTEM-SERVICE-TYPE. (Service Reference): Document it. Update 'fold-services' documentation.
Diffstat (limited to 'gnu/services.scm')
-rw-r--r--gnu/services.scm51
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