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:
Ludovic Courtès 2015-10-14 15:09:18 +02:00
parent 5152d13b51
commit 00184239c3
4 changed files with 16 additions and 3 deletions

View file

@ -125,7 +125,8 @@ (define %root-file-system-dmd-service
(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 @@ (define file-system-service-type
;; 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 @@ (define* (file-system-service file-system)
(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 @@ (define %do-not-kill-file
(define user-processes-service-type
(dmd-service-type
'user-processes
(match-lambda
((requirements grace-delay)
(dmd-service
@ -337,6 +341,7 @@ (define* (user-processes-service file-systems #:key (grace-delay 4))
(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 @@ (define (unicode-start tty)
(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 @@ (define (console-keymap-service file)
(define console-font-service-type
(dmd-service-type
'console-font
(match-lambda
((tty font)
(let ((device (string-append "/dev/" tty)))
@ -644,6 +651,7 @@ (define* (nscd-service #:optional (config %nscd-default-configuration))
(define syslog-service-type
(dmd-service-type
'syslog
(lambda (config-file)
(dmd-service
(documentation "Run the syslog daemon (syslogd).")
@ -982,6 +990,7 @@ (define* (udev-service #:key (udev eudev) (rules '()))
(define device-mapping-service-type
(dmd-service-type
'device-mapping
(match-lambda
((target open close)
(dmd-service
@ -1001,6 +1010,7 @@ (define (device-mapping-service target open close)
(define swap-service-type
(dmd-service-type
'swap
(lambda (device)
(define requirement
(if (string-prefix? "/dev/mapper/" device)

View file

@ -86,11 +86,11 @@ (define %dmd-root-service
;; <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))))))

View file

@ -94,6 +94,7 @@ (define-record-type* <static-networking>
(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 @@ (define* (static-networking-service interface ip
(define dhcp-client-service-type
(dmd-service-type
'dhcp-client
(lambda (dhcp)
(define dhclient
#~(string-append #$dhcp "/sbin/dhclient"))

View file

@ -162,6 +162,7 @@ (define (set-store-permissions directory)
(define cow-store-service-type
(dmd-service-type
'cow-store
(lambda _
(dmd-service
(requirement '(root-file-system user-processes))