summaryrefslogtreecommitdiff
path: root/gnu/system.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/system.scm
parent3a391e68dafe81560d3e4936a1ec5ac3b06d43bb (diff)
downloadpatches-d62e201cfd0f1e48c14586489d0e2b80ce943d4f.tar
patches-d62e201cfd0f1e48c14586489d0e2b80ce943d4f.tar.gz
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.scm54
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