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
					
				
					 2 changed files with 31 additions and 1 deletions
				
			
		|  | @ -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 | ||||
|  |  | |||
		Reference in a new issue