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

system: Add support for swap devices.

Browse Source 
* 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:
Ludovic Courtès 2014-09-18 22:51:48 +02:00
parent 715fc9d44d
commit 2a13d05e45
2 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gnu/services/base.scm
View File

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

10
gnu/system.scm
View File

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