futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

services: Add 'system-service-type'.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2015-11-02 18:44:17 +01:00
parent 3a391e68da
commit d62e201cfd
6 changed files with 103 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
doc/guix.texi
View File

@ -7589,8 +7589,11 @@ as arrows, a typical system might provide something like this:
@image{images/service-graph,,5in,Typical service extension graph.}
At the bottom, we see the @dfn{boot service}, which produces the boot
script that is executed at boot time from the initial RAM disk.
@cindex system service
At the bottom, we see the @dfn{system service}, which produces the
directory containing everything to run and boot the system, as returned
by the @command{guix system build} command. @xref{Service Reference},
to learn about the other service types shown here.
@xref{system-extension-graph, the @command{guix system extension-graph}
command}, for information on how to generate this representation for a
particular operating system definition.
@ -7853,12 +7856,14 @@ Return true if @var{obj} is a service extension.
At the core of the service abstraction lies the @code{fold-services}
procedure, which is responsible for ``compiling'' a list of services
down to a single boot script. In essence, it propagates service
extensions down the service graph, updating each node parameters on the
way, until it reaches the root node.
down to a single directory that contains everything needed to boot and
run the system---the directory shown by the @command{guix system build}
command (@pxref{Invoking guix system}). In essence, it propagates
service extensions down the service graph, updating each node parameters
on the way, until it reaches the root node.
@deffn {Scheme Procedure} fold-services @var{services} @
[#:target-type @var{boot-service-type}]
[#:target-type @var{system-service-type}]
Fold @var{services} by propagating their extensions down to the root of
type @var{target-type}; return the root service adjusted accordingly.
@end deffn
@ -7866,9 +7871,14 @@ type @var{target-type}; return the root service adjusted accordingly.
Lastly, the @code{(gnu services)} module also defines several essential
service types, some of which are listed below.
@defvr {Scheme Variable} system-service-type
This is the root of the service graph. It produces the system directory
as returned by the @command{guix system build} command.
@end defvr
@defvr {Scheme Variable} boot-service-type
The type of the ``boot service'', which is the root of the service
graph.
The type of the ``boot service'', which produces the @dfn{boot script}.
The boot script is what the initial RAM disk runs when booting.
@end defvr
@defvr {Scheme Variable} etc-service-type

5
doc/images/service-graph.dot
View File

@ -4,7 +4,8 @@ digraph "Service Type Dependencies" {
etc [shape = box, fontname = Helvetica];
accounts [shape = box, fontname = Helvetica];
activation [shape = box, fontname = Helvetica];
boot [shape = house, fontname = Helvetica];
boot [shape = box, fontname = Helvetica];
system [shape = house, fontname = Helvetica];
lshd -> dmd;
lshd -> pam;
udev -> dmd;
@ -32,4 +33,6 @@ digraph "Service Type Dependencies" {
guix -> dmd;
guix -> activation;
guix -> accounts;
boot -> system;
etc -> system;
}

51
gnu/services.scm
View File

@ -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

54
gnu/system.scm
View File

@ -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

18
gnu/system/linux-container.scm
View File

@ -47,20 +47,6 @@
(check? #f)
(create-mount-point? #t)))))
(define (system-container os)
"Return a derivation that builds OS as a Linux container."
(mlet* %store-monad
((profile (operating-system-profile os))
(etc -> (operating-system-etc-directory os))
(boot (operating-system-boot-script os #:container? #t))
(locale (operating-system-locale-directory os)))
(lower-object
(file-union "system-container"
`(("boot" ,#~#$boot)
("profile" ,#~#$profile)
("locale" ,#~#$locale)
("etc" ,#~#$etc))))))
(define (containerized-operating-system os mappings)
"Return an operating system based on OS for use in a Linux container
environment. MAPPINGS is a list of <file-system-mapping> to realize in the
@ -95,7 +81,9 @@ that will be shared with the host system."
(operating-system-file-systems os)))
(specs (map file-system->spec file-systems)))
(mlet* %store-monad ((os-drv (system-container os)))
(mlet* %store-monad ((os-drv (operating-system-derivation
os
#:container? #t)))
(define script
#~(begin

6
guix/scripts/system.scm
View File

@ -491,10 +491,10 @@ building anything."
(define (export-extension-graph os port)
"Export the service extension graph of OS to PORT."
(let* ((services (operating-system-services os))
(boot (find (lambda (service)
(eq? (service-kind service) boot-service-type))
(system (find (lambda (service)
(eq? (service-kind service) system-service-type))
services)))
(export-graph (list boot) (current-output-port)
(export-graph (list system) (current-output-port)
#:node-type (service-node-type services)
#:reverse-edges? #t)))