system: Add support for swap devices.
* gnu/services/base.scm (swap-service): New procedure. * gnu/system.scm (<operating-system>)[swap-devices]: New field. (swap-services): New procedure. (essential-services): Use it.
This commit is contained in:
parent
715fc9d44d
commit
2a13d05e45
|
@ -39,6 +39,7 @@
|
|||
#:export (root-file-system-service
|
||||
file-system-service
|
||||
device-mapping-service
|
||||
swap-service
|
||||
user-processes-service
|
||||
host-name-service
|
||||
console-font-service
|
||||
|
@ -614,6 +615,27 @@ gexp, to open it, and evaluate @var{close} to close it."
|
|||
(stop #~(lambda _ (not #$close)))
|
||||
(respawn? #f)))))
|
||||
|
||||
(define (swap-service device)
|
||||
"Return a service that uses @var{device} as a swap device."
|
||||
(define requirement
|
||||
(if (string-prefix? "/dev/mapper/" device)
|
||||
(list (symbol-append 'device-mapping-
|
||||
(string->symbol (basename device))))
|
||||
'()))
|
||||
|
||||
(with-monad %store-monad
|
||||
(return (service
|
||||
(provision (list (symbol-append 'swap- (string->symbol device))))
|
||||
(requirement `(udev ,@requirement))
|
||||
(documentation "Enable the given swap device.")
|
||||
(start #~(lambda ()
|
||||
(swapon #$device)
|
||||
#t))
|
||||
(stop #~(lambda _
|
||||
(swapoff #$device)
|
||||
#f))
|
||||
(respawn? #f)))))
|
||||
|
||||
(define %base-services
|
||||
;; Convenience variable holding the basic services.
|
||||
(let ((motd (text-file "motd" "
|
||||
|
|
|
@ -105,6 +105,8 @@
|
|||
(mapped-devices operating-system-mapped-devices ; list of <mapped-device>
|
||||
(default '()))
|
||||
(file-systems operating-system-file-systems) ; list of fs
|
||||
(swap-devices operating-system-swap-devices ; list of strings
|
||||
(default '()))
|
||||
|
||||
(users operating-system-users ; list of user accounts
|
||||
(default '()))
|
||||
|
@ -228,6 +230,11 @@ as 'needed-for-boot'."
|
|||
(close source target))))
|
||||
(operating-system-mapped-devices os))))
|
||||
|
||||
(define (swap-services os)
|
||||
"Return the list of swap services for OS as a monadic list."
|
||||
(sequence %store-monad
|
||||
(map swap-service (operating-system-swap-devices os))))
|
||||
|
||||
(define (essential-services os)
|
||||
"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
|
||||
|
@ -235,13 +242,14 @@ bookkeeping."
|
|||
(mlet* %store-monad ((mappings (device-mapping-services os))
|
||||
(root-fs (root-file-system-service))
|
||||
(other-fs (other-file-system-services os))
|
||||
(swaps (swap-services os))
|
||||
(procs (user-processes-service
|
||||
(map (compose first service-provision)
|
||||
other-fs)))
|
||||
(host-name (host-name-service
|
||||
(operating-system-host-name os))))
|
||||
(return (cons* host-name procs root-fs
|
||||
(append other-fs mappings)))))
|
||||
(append other-fs mappings swaps)))))
|
||||
|
||||
(define (operating-system-services os)
|
||||
"Return all the services of OS, including \"internal\" services that do not
|
||||
|
|
Loading…
Reference in New Issue