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 |   #: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 @@ gexp, to open it, and evaluate @var{close} to close it." | ||||||
|              (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" " | ||||||
|  |  | ||||||
|  | @ -105,6 +105,8 @@ | ||||||
|   (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 @@ as 'needed-for-boot'." | ||||||
|                                              (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 @@ bookkeeping." | ||||||
|   (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 | ||||||
|  |  | ||||||
		Reference in a new issue