services: 'dmd-service-type' takes a service name.
* gnu/services/dmd.scm (dmd-service-type): Add 'service-name' parameter. * gnu/services/base.scm, gnu/services/networking.scm, gnu/system/install.scm: Adjust callers.
This commit is contained in:
		
							parent
							
								
									5152d13b51
								
							
						
					
					
						commit
						00184239c3
					
				
					 4 changed files with 16 additions and 3 deletions
				
			
		| 
						 | 
				
			
			@ -125,7 +125,8 @@
 | 
			
		|||
   (respawn? #f)))
 | 
			
		||||
 | 
			
		||||
(define root-file-system-service-type
 | 
			
		||||
  (dmd-service-type (const %root-file-system-dmd-service)))
 | 
			
		||||
  (dmd-service-type 'root-file-system
 | 
			
		||||
                    (const %root-file-system-dmd-service)))
 | 
			
		||||
 | 
			
		||||
(define (root-file-system-service)
 | 
			
		||||
  "Return a service whose sole purpose is to re-mount read-only the root file
 | 
			
		||||
| 
						 | 
				
			
			@ -145,6 +146,7 @@ FILE-SYSTEM."
 | 
			
		|||
  ;; TODO(?): Make this an extensible service that takes <file-system> objects
 | 
			
		||||
  ;; and returns a list of <dmd-service>.
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'file-system
 | 
			
		||||
   (lambda (file-system)
 | 
			
		||||
     (let ((target  (file-system-mount-point file-system))
 | 
			
		||||
           (device  (file-system-device file-system))
 | 
			
		||||
| 
						 | 
				
			
			@ -205,6 +207,7 @@ object."
 | 
			
		|||
 | 
			
		||||
(define user-unmount-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'user-unmount
 | 
			
		||||
   (lambda (known-mount-points)
 | 
			
		||||
     (dmd-service
 | 
			
		||||
      (documentation "Unmount manually-mounted file systems.")
 | 
			
		||||
| 
						 | 
				
			
			@ -242,6 +245,7 @@ in KNOWN-MOUNT-POINTS when it is stopped."
 | 
			
		|||
 | 
			
		||||
(define user-processes-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'user-processes
 | 
			
		||||
   (match-lambda
 | 
			
		||||
     ((requirements grace-delay)
 | 
			
		||||
      (dmd-service
 | 
			
		||||
| 
						 | 
				
			
			@ -337,6 +341,7 @@ stopped before 'kill' is called."
 | 
			
		|||
 | 
			
		||||
(define host-name-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'host-name
 | 
			
		||||
   (lambda (name)
 | 
			
		||||
     (dmd-service
 | 
			
		||||
      (documentation "Initialize the machine's host name.")
 | 
			
		||||
| 
						 | 
				
			
			@ -369,6 +374,7 @@ stopped before 'kill' is called."
 | 
			
		|||
 | 
			
		||||
(define console-keymap-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'console-keymap
 | 
			
		||||
   (lambda (file)
 | 
			
		||||
     (dmd-service
 | 
			
		||||
      (documentation (string-append "Load console keymap (loadkeys)."))
 | 
			
		||||
| 
						 | 
				
			
			@ -384,6 +390,7 @@ stopped before 'kill' is called."
 | 
			
		|||
 | 
			
		||||
(define console-font-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'console-font
 | 
			
		||||
   (match-lambda
 | 
			
		||||
     ((tty font)
 | 
			
		||||
      (let ((device (string-append "/dev/" tty)))
 | 
			
		||||
| 
						 | 
				
			
			@ -644,6 +651,7 @@ Service Switch}, for an example."
 | 
			
		|||
 | 
			
		||||
(define syslog-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'syslog
 | 
			
		||||
   (lambda (config-file)
 | 
			
		||||
     (dmd-service
 | 
			
		||||
      (documentation "Run the syslog daemon (syslogd).")
 | 
			
		||||
| 
						 | 
				
			
			@ -982,6 +990,7 @@ extra rules from the packages listed in @var{rules}."
 | 
			
		|||
 | 
			
		||||
(define device-mapping-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'device-mapping
 | 
			
		||||
   (match-lambda
 | 
			
		||||
     ((target open close)
 | 
			
		||||
      (dmd-service
 | 
			
		||||
| 
						 | 
				
			
			@ -1001,6 +1010,7 @@ gexp, to open it, and evaluate @var{close} to close it."
 | 
			
		|||
 | 
			
		||||
(define swap-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'swap
 | 
			
		||||
   (lambda (device)
 | 
			
		||||
     (define requirement
 | 
			
		||||
       (if (string-prefix? "/dev/mapper/" device)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -86,11 +86,11 @@
 | 
			
		|||
  ;; <dmd-service> objects.
 | 
			
		||||
  (service dmd-root-service-type '()))
 | 
			
		||||
 | 
			
		||||
(define-syntax-rule (dmd-service-type proc)
 | 
			
		||||
(define-syntax-rule (dmd-service-type service-name proc)
 | 
			
		||||
  "Return a <service-type> denoting a simple dmd service--i.e., the type for a
 | 
			
		||||
service that extends DMD-ROOT-SERVICE-TYPE and nothing else."
 | 
			
		||||
  (service-type
 | 
			
		||||
   (name 'some-dmd-service)
 | 
			
		||||
   (name service-name)
 | 
			
		||||
   (extensions
 | 
			
		||||
    (list (service-extension dmd-root-service-type
 | 
			
		||||
                             (compose list proc))))))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -94,6 +94,7 @@ fe80::1%lo0 apps.facebook.com\n")
 | 
			
		|||
 | 
			
		||||
(define static-networking-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'static-networking
 | 
			
		||||
   (match-lambda
 | 
			
		||||
     (($ <static-networking> interface ip gateway provision
 | 
			
		||||
                             name-servers net-tools)
 | 
			
		||||
| 
						 | 
				
			
			@ -166,6 +167,7 @@ gateway."
 | 
			
		|||
 | 
			
		||||
(define dhcp-client-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'dhcp-client
 | 
			
		||||
   (lambda (dhcp)
 | 
			
		||||
     (define dhclient
 | 
			
		||||
       #~(string-append #$dhcp "/sbin/dhclient"))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -162,6 +162,7 @@ current store is on a RAM disk."
 | 
			
		|||
 | 
			
		||||
(define cow-store-service-type
 | 
			
		||||
  (dmd-service-type
 | 
			
		||||
   'cow-store
 | 
			
		||||
   (lambda _
 | 
			
		||||
     (dmd-service
 | 
			
		||||
      (requirement '(root-file-system user-processes))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue