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:
Ludovic Courtès 2014-09-18 22:51:48 +02:00
parent 715fc9d44d
commit 2a13d05e45
2 changed files with 31 additions and 1 deletions

View file

@ -39,6 +39,7 @@ (define-module (gnu services base)
#:export (root-file-system-service #:export (root-file-system-service
file-system-service file-system-service
device-mapping-service device-mapping-service
swap-service
user-processes-service user-processes-service
host-name-service host-name-service
console-font-service console-font-service
@ -614,6 +615,27 @@ (define (device-mapping-service target open close)
(stop #~(lambda _ (not #$close))) (stop #~(lambda _ (not #$close)))
(respawn? #f))))) (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 (define %base-services
;; Convenience variable holding the basic services. ;; Convenience variable holding the basic services.
(let ((motd (text-file "motd" " (let ((motd (text-file "motd" "

View file

@ -105,6 +105,8 @@ (define-record-type* <operating-system> operating-system
(mapped-devices operating-system-mapped-devices ; list of <mapped-device> (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
(default '())) (default '()))
(file-systems operating-system-file-systems) ; list of fs (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 (users operating-system-users ; list of user accounts
(default '())) (default '()))
@ -228,6 +230,11 @@ (define (device-mapping-services os)
(close source target)))) (close source target))))
(operating-system-mapped-devices os)))) (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) (define (essential-services os)
"Return the list of essential services for OS. These are special services "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 that implement part of what's declared in OS are responsible for low-level
@ -235,13 +242,14 @@ (define (essential-services os)
(mlet* %store-monad ((mappings (device-mapping-services os)) (mlet* %store-monad ((mappings (device-mapping-services os))
(root-fs (root-file-system-service)) (root-fs (root-file-system-service))
(other-fs (other-file-system-services os)) (other-fs (other-file-system-services os))
(swaps (swap-services os))
(procs (user-processes-service (procs (user-processes-service
(map (compose first service-provision) (map (compose first service-provision)
other-fs))) other-fs)))
(host-name (host-name-service (host-name (host-name-service
(operating-system-host-name os)))) (operating-system-host-name os))))
(return (cons* host-name procs root-fs (return (cons* host-name procs root-fs
(append other-fs mappings))))) (append other-fs mappings swaps)))))
(define (operating-system-services os) (define (operating-system-services os)
"Return all the services of OS, including \"internal\" services that do not "Return all the services of OS, including \"internal\" services that do not