diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-09-18 22:51:48 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-09-18 22:52:01 +0200 |
| commit | 2a13d05e459946d4989e08461233d7f147f029f5 (patch) | |
| tree | 648676170ffd849fca28d245093b30206035a715 /gnu | |
| parent | 715fc9d44d284a0c5e1ded45091eaf979aa5ecd4 (diff) | |
| download | gnu-guix-2a13d05e459946d4989e08461233d7f147f029f5.tar gnu-guix-2a13d05e459946d4989e08461233d7f147f029f5.tar.gz | |
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.
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/base.scm | 22 | ||||
| -rw-r--r-- | gnu/system.scm | 10 |
2 files changed, 31 insertions, 1 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index f2de85f410..b38d3e3765 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -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" " diff --git a/gnu/system.scm b/gnu/system.scm index 6f0469a763..13b461c003 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -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 |