services: nfs: Allow pipefs-service-type to be extended.
* gnu/services/nfs.scm (pipefs-service-type): Rewrite using SERVICE-TYPE to add ability to extend the service.
This commit is contained in:
		
							parent
							
								
									ba1808d5e7
								
							
						
					
					
						commit
						25c8c8cd4f
					
				
					 1 changed files with 25 additions and 14 deletions
				
			
		| 
						 | 
					@ -24,6 +24,7 @@
 | 
				
			||||||
  #:use-module (gnu packages linux)
 | 
					  #:use-module (gnu packages linux)
 | 
				
			||||||
  #:use-module (guix)
 | 
					  #:use-module (guix)
 | 
				
			||||||
  #:use-module (guix records)
 | 
					  #:use-module (guix records)
 | 
				
			||||||
 | 
					  #:use-module (srfi srfi-1)
 | 
				
			||||||
  #:use-module (ice-9 match)
 | 
					  #:use-module (ice-9 match)
 | 
				
			||||||
  #:use-module (gnu build file-systems)
 | 
					  #:use-module (gnu build file-systems)
 | 
				
			||||||
  #:export (rpcbind-service-type
 | 
					  #:export (rpcbind-service-type
 | 
				
			||||||
| 
						 | 
					@ -96,23 +97,33 @@
 | 
				
			||||||
                         (default default-pipefs-directory)))
 | 
					                         (default default-pipefs-directory)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define pipefs-service-type
 | 
					(define pipefs-service-type
 | 
				
			||||||
  (shepherd-service-type
 | 
					  (let ((proc
 | 
				
			||||||
   'pipefs
 | 
					         (lambda (config)
 | 
				
			||||||
   (lambda (config)
 | 
					           (define pipefs-directory (pipefs-configuration-mount-point config))
 | 
				
			||||||
     (define pipefs-directory (pipefs-configuration-mount-point config))
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
     (shepherd-service
 | 
					           (shepherd-service
 | 
				
			||||||
      (documentation "Mount the pipefs pseudo file system.")
 | 
					            (documentation "Mount the pipefs pseudo file system.")
 | 
				
			||||||
      (provision '(rpc-pipefs))
 | 
					            (provision '(rpc-pipefs))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      (start #~(lambda ()
 | 
					            (start #~(lambda ()
 | 
				
			||||||
                 (mkdir-p #$pipefs-directory)
 | 
					                       (mkdir-p #$pipefs-directory)
 | 
				
			||||||
                 (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
 | 
					                       (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
 | 
				
			||||||
                 (member #$pipefs-directory (mount-points))))
 | 
					                       (member #$pipefs-directory (mount-points))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      (stop #~(lambda (pid . args)
 | 
					            (stop #~(lambda (pid . args)
 | 
				
			||||||
                (umount #$pipefs-directory MNT_DETACH)
 | 
					                      (umount #$pipefs-directory MNT_DETACH)
 | 
				
			||||||
                (not (member #$pipefs-directory (mount-points)))))))))
 | 
					                      (not (member #$pipefs-directory (mount-points)))))))))
 | 
				
			||||||
 | 
					    (service-type
 | 
				
			||||||
 | 
					     (name 'pipefs)
 | 
				
			||||||
 | 
					     (extensions
 | 
				
			||||||
 | 
					      (list (service-extension shepherd-root-service-type
 | 
				
			||||||
 | 
					                               (compose list proc))))
 | 
				
			||||||
 | 
					     ;; We use the extensions feature to allow other services to automatically
 | 
				
			||||||
 | 
					     ;; configure and start this service.  Only one value can be provided.  We
 | 
				
			||||||
 | 
					     ;; override it with the value returned by the extending service.
 | 
				
			||||||
 | 
					     (compose identity)
 | 
				
			||||||
 | 
					     (extend (lambda (config values) (first values)))
 | 
				
			||||||
 | 
					     (default-value (pipefs-configuration)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue