diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-11-02 18:44:17 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-11-02 22:25:11 +0100 |
commit | d62e201cfd0f1e48c14586489d0e2b80ce943d4f (patch) | |
tree | d6c4989b36b54f154f21363ac72bd9896729f2de /gnu/system.scm | |
parent | 3a391e68dafe81560d3e4936a1ec5ac3b06d43bb (diff) | |
download | guix-d62e201cfd0f1e48c14586489d0e2b80ce943d4f.tar.gz guix-d62e201cfd0f1e48c14586489d0e2b80ce943d4f.zip |
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/system.scm')
-rw-r--r-- | gnu/system.scm | 54 |
1 files changed, 31 insertions, 23 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 8fed857b39..c26d27028b 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -254,6 +254,24 @@ from the initrd." "Return the list of swap services for OS." (map swap-service (operating-system-swap-devices os))) +(define* (operating-system-directory-base-entries os #:key container?) + "Return the basic entries of the 'system' directory of OS for use as the +value of the SYSTEM-SERVICE-TYPE service." + (mlet* %store-monad ((profile (operating-system-profile os)) + (locale (operating-system-locale-directory os))) + (if container? + (return `(("profile" ,profile) + ("locale" ,locale))) + (mlet %store-monad + ((kernel -> (operating-system-kernel os)) + (initrd (operating-system-initrd-file os)) + (params (operating-system-parameters-file os))) + (return `(("kernel" ,kernel) + ("parameters" ,params) + ("initrd" ,initrd) + ("profile" ,profile) + ("locale" ,locale))))))) ;used by libc + (define* (essential-services os #:key container?) "Return the list of essential services for OS. These are special services that implement part of what's declared in OS are responsible for low-level @@ -269,8 +287,11 @@ a container or that of a \"bare metal\" system." (swaps (swap-services os)) (procs (user-processes-service (map service-parameters other-fs))) - (host-name (host-name-service (operating-system-host-name os)))) - (cons* %boot-service + (host-name (host-name-service (operating-system-host-name os))) + (entries (operating-system-directory-base-entries + os #:container? container?))) + (cons* (service system-service-type entries) + %boot-service ;; %DMD-ROOT-SERVICE must come first so that the gexp that execs ;; dmd comes last in the boot script (XXX). @@ -607,10 +628,17 @@ etc." we're running in the final root. When CONTAINER? is true, skip all hardware-related operations as necessary when booting a Linux container." (let* ((services (operating-system-services os #:container? container?)) - (boot (fold-services services))) + (boot (fold-services services #:target-type boot-service-type))) ;; BOOT is the script as a monadic value. (service-parameters boot))) +(define* (operating-system-derivation os #:key container?) + "Return a derivation that builds OS." + (let* ((services (operating-system-services os #:container? container?)) + (system (fold-services services))) + ;; SYSTEM contains the derivation as a monadic value. + (service-parameters system))) + (define (operating-system-root-file-system os) "Return the root file system of OS." (find (match-lambda @@ -693,24 +721,4 @@ this file is the reconstruction of GRUB menu entries for old configurations." #$(operating-system-kernel-arguments os)) (initrd #$initrd))))) -(define (operating-system-derivation os) - "Return a derivation that builds OS." - (mlet* %store-monad - ((profile (operating-system-profile os)) - (etc -> (operating-system-etc-directory os)) - (boot (operating-system-boot-script os)) - (kernel -> (operating-system-kernel os)) - (initrd (operating-system-initrd-file os)) - (locale (operating-system-locale-directory os)) - (params (operating-system-parameters-file os))) - (lower-object - (file-union "system" - `(("boot" ,#~#$boot) - ("kernel" ,#~#$kernel) - ("parameters" ,#~#$params) - ("initrd" ,initrd) - ("profile" ,#~#$profile) - ("locale" ,#~#$locale) ;used by libc - ("etc" ,#~#$etc)))))) - ;;; system.scm ends here |