mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-26 04:29:25 -05:00
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 @@ (define %root-file-system-dmd-service
|
||||||
(respawn? #f)))
|
(respawn? #f)))
|
||||||
|
|
||||||
(define root-file-system-service-type
|
(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)
|
(define (root-file-system-service)
|
||||||
"Return a service whose sole purpose is to re-mount read-only the root file
|
"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
|
;; TODO(?): Make this an extensible service that takes <file-system> objects
|
||||||
;; and returns a list of <dmd-service>.
|
;; and returns a list of <dmd-service>.
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'file-system
|
||||||
(lambda (file-system)
|
(lambda (file-system)
|
||||||
(let ((target (file-system-mount-point file-system))
|
(let ((target (file-system-mount-point file-system))
|
||||||
(device (file-system-device file-system))
|
(device (file-system-device file-system))
|
||||||
|
@ -205,6 +207,7 @@ (define* (file-system-service file-system)
|
||||||
|
|
||||||
(define user-unmount-service-type
|
(define user-unmount-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'user-unmount
|
||||||
(lambda (known-mount-points)
|
(lambda (known-mount-points)
|
||||||
(dmd-service
|
(dmd-service
|
||||||
(documentation "Unmount manually-mounted file systems.")
|
(documentation "Unmount manually-mounted file systems.")
|
||||||
|
@ -242,6 +245,7 @@ (define %do-not-kill-file
|
||||||
|
|
||||||
(define user-processes-service-type
|
(define user-processes-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'user-processes
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((requirements grace-delay)
|
((requirements grace-delay)
|
||||||
(dmd-service
|
(dmd-service
|
||||||
|
@ -337,6 +341,7 @@ (define* (user-processes-service file-systems #:key (grace-delay 4))
|
||||||
|
|
||||||
(define host-name-service-type
|
(define host-name-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'host-name
|
||||||
(lambda (name)
|
(lambda (name)
|
||||||
(dmd-service
|
(dmd-service
|
||||||
(documentation "Initialize the machine's host name.")
|
(documentation "Initialize the machine's host name.")
|
||||||
|
@ -369,6 +374,7 @@ (define (unicode-start tty)
|
||||||
|
|
||||||
(define console-keymap-service-type
|
(define console-keymap-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'console-keymap
|
||||||
(lambda (file)
|
(lambda (file)
|
||||||
(dmd-service
|
(dmd-service
|
||||||
(documentation (string-append "Load console keymap (loadkeys)."))
|
(documentation (string-append "Load console keymap (loadkeys)."))
|
||||||
|
@ -384,6 +390,7 @@ (define (console-keymap-service file)
|
||||||
|
|
||||||
(define console-font-service-type
|
(define console-font-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'console-font
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((tty font)
|
((tty font)
|
||||||
(let ((device (string-append "/dev/" tty)))
|
(let ((device (string-append "/dev/" tty)))
|
||||||
|
@ -644,6 +651,7 @@ (define* (nscd-service #:optional (config %nscd-default-configuration))
|
||||||
|
|
||||||
(define syslog-service-type
|
(define syslog-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'syslog
|
||||||
(lambda (config-file)
|
(lambda (config-file)
|
||||||
(dmd-service
|
(dmd-service
|
||||||
(documentation "Run the syslog daemon (syslogd).")
|
(documentation "Run the syslog daemon (syslogd).")
|
||||||
|
@ -982,6 +990,7 @@ (define* (udev-service #:key (udev eudev) (rules '()))
|
||||||
|
|
||||||
(define device-mapping-service-type
|
(define device-mapping-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'device-mapping
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((target open close)
|
((target open close)
|
||||||
(dmd-service
|
(dmd-service
|
||||||
|
@ -1001,6 +1010,7 @@ (define (device-mapping-service target open close)
|
||||||
|
|
||||||
(define swap-service-type
|
(define swap-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'swap
|
||||||
(lambda (device)
|
(lambda (device)
|
||||||
(define requirement
|
(define requirement
|
||||||
(if (string-prefix? "/dev/mapper/" device)
|
(if (string-prefix? "/dev/mapper/" device)
|
||||||
|
|
|
@ -86,11 +86,11 @@ (define %dmd-root-service
|
||||||
;; <dmd-service> objects.
|
;; <dmd-service> objects.
|
||||||
(service dmd-root-service-type '()))
|
(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
|
"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 that extends DMD-ROOT-SERVICE-TYPE and nothing else."
|
||||||
(service-type
|
(service-type
|
||||||
(name 'some-dmd-service)
|
(name service-name)
|
||||||
(extensions
|
(extensions
|
||||||
(list (service-extension dmd-root-service-type
|
(list (service-extension dmd-root-service-type
|
||||||
(compose list proc))))))
|
(compose list proc))))))
|
||||||
|
|
|
@ -94,6 +94,7 @@ (define-record-type* <static-networking>
|
||||||
|
|
||||||
(define static-networking-service-type
|
(define static-networking-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'static-networking
|
||||||
(match-lambda
|
(match-lambda
|
||||||
(($ <static-networking> interface ip gateway provision
|
(($ <static-networking> interface ip gateway provision
|
||||||
name-servers net-tools)
|
name-servers net-tools)
|
||||||
|
@ -166,6 +167,7 @@ (define* (static-networking-service interface ip
|
||||||
|
|
||||||
(define dhcp-client-service-type
|
(define dhcp-client-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'dhcp-client
|
||||||
(lambda (dhcp)
|
(lambda (dhcp)
|
||||||
(define dhclient
|
(define dhclient
|
||||||
#~(string-append #$dhcp "/sbin/dhclient"))
|
#~(string-append #$dhcp "/sbin/dhclient"))
|
||||||
|
|
|
@ -162,6 +162,7 @@ (define (set-store-permissions directory)
|
||||||
|
|
||||||
(define cow-store-service-type
|
(define cow-store-service-type
|
||||||
(dmd-service-type
|
(dmd-service-type
|
||||||
|
'cow-store
|
||||||
(lambda _
|
(lambda _
|
||||||
(dmd-service
|
(dmd-service
|
||||||
(requirement '(root-file-system user-processes))
|
(requirement '(root-file-system user-processes))
|
||||||
|
|
Loading…
Reference in a new issue