mapped-devices: 'mapped-device-service' takes a <mapped-device>.
* gnu/system/mapped-devices.scm (device-mapping-service): Take a <mapped-device> instead of 3 parameters. (device-mapping-service-type): Adjust accordingly. * gnu/system.scm (device-mapping-services): Adjust accordingly.
This commit is contained in:
		
							parent
							
								
									1ea507bce2
								
							
						
					
					
						commit
						4da8c19e83
					
				
					 2 changed files with 8 additions and 18 deletions
				
			
		| 
						 | 
					@ -233,15 +233,7 @@ from the initrd."
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (device-mapping-services os)
 | 
					(define (device-mapping-services os)
 | 
				
			||||||
  "Return the list of device-mapping services for OS as a list."
 | 
					  "Return the list of device-mapping services for OS as a list."
 | 
				
			||||||
  (map (lambda (md)
 | 
					  (map device-mapping-service
 | 
				
			||||||
         (let* ((source (mapped-device-source md))
 | 
					 | 
				
			||||||
                (target (mapped-device-target md))
 | 
					 | 
				
			||||||
                (type   (mapped-device-type md))
 | 
					 | 
				
			||||||
                (open   (mapped-device-kind-open type))
 | 
					 | 
				
			||||||
                (close  (mapped-device-kind-close type)))
 | 
					 | 
				
			||||||
           (device-mapping-service target
 | 
					 | 
				
			||||||
                                   (open source target)
 | 
					 | 
				
			||||||
                                   (close source target))))
 | 
					 | 
				
			||||||
       (operating-system-user-mapped-devices os)))
 | 
					       (operating-system-user-mapped-devices os)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (swap-services os)
 | 
					(define (swap-services os)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -69,21 +69,19 @@
 | 
				
			||||||
  (shepherd-service-type
 | 
					  (shepherd-service-type
 | 
				
			||||||
   'device-mapping
 | 
					   'device-mapping
 | 
				
			||||||
   (match-lambda
 | 
					   (match-lambda
 | 
				
			||||||
     ((target open close)
 | 
					     (($ <mapped-device> source target
 | 
				
			||||||
 | 
					                         ($ <mapped-device-type> open close))
 | 
				
			||||||
      (shepherd-service
 | 
					      (shepherd-service
 | 
				
			||||||
       (provision (list (symbol-append 'device-mapping- (string->symbol target))))
 | 
					       (provision (list (symbol-append 'device-mapping- (string->symbol target))))
 | 
				
			||||||
       (requirement '(udev))
 | 
					       (requirement '(udev))
 | 
				
			||||||
       (documentation "Map a device node using Linux's device mapper.")
 | 
					       (documentation "Map a device node using Linux's device mapper.")
 | 
				
			||||||
       (start #~(lambda () #$open))
 | 
					       (start #~(lambda () #$(open source target)))
 | 
				
			||||||
       (stop #~(lambda _ (not #$close)))
 | 
					       (stop #~(lambda _ (not #$(close source target))))
 | 
				
			||||||
       (respawn? #f))))))
 | 
					       (respawn? #f))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (device-mapping-service target open close)
 | 
					(define (device-mapping-service mapped-device)
 | 
				
			||||||
  "Return a service that maps device @var{target}, a string such as
 | 
					  "Return a service that sets up @var{mapped-device}."
 | 
				
			||||||
@code{\"home\"} (meaning @code{/dev/mapper/home}).  Evaluate @var{open}, a
 | 
					  (service device-mapping-service-type mapped-device))
 | 
				
			||||||
gexp, to open it, and evaluate @var{close} to close it."
 | 
					 | 
				
			||||||
  (service device-mapping-service-type
 | 
					 | 
				
			||||||
           (list target open close)))
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue