mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -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)))
|
||||
|
||||
(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)
|
||||
|
|
|
@ -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))))))
|
||||
|
|
|
@ -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"))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in a new issue