mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
services: Rename 'dmd' services to 'shepherd'.
* gnu/services/shepherd.scm (dmd-root-service-type, %dmd-root-service)
(dmd-service-type, <dmd-service>, dmd-service, dmd-service?)
(make-dmd-service, dmd-service-documentation, dmd-service-provision)
(dmd-service-requirement, dmd-service-respawn, dmd-service-start)
(dmd-service-stop, dmd-service-auto-start?, dmd-service-modules)
(dmd-service-imported-modules, dmd-service-file-name, dmd-service-file)
(dmd-service-back-edges): Rename to...
(shepherd-root-service-type, %shepherd-root-service, shepherd-service-type)
(<shepherd-service>, shepherd-service, shepherd-service?)
(make-shepherd-service, shepherd-service-documentation)
(shepherd-service-provision, shepherd-service-requirement)
(shepherd-service-respawn, shepherd-service-start)
(shepherd-service-stop, shepherd-service-auto-start?)
(shepherd-service-modules, shepherd-service-imported-modules)
(shepherd-service-file-name, shepherd-service-file)
(shepherd-service-back-edges): ...this
* gnu/services.scm: Adjust comments.
* gnu/services/avahi.scm (avahi-dmd-service): Rename to...
(avahi-shepherd-service): ... this.
* gnu/services/base.scm (%root-file-system-dmd-service)
(file-system->dmd-service-name, mapped-device->dmd-service-name)
(dependency->dmd-service-name, file-system-dmd-service)
(mingetty-dmd-service, nscd-dmd-service, guix-dmd-service)
(guix-publish-dmd-service, udev-dmd-service, gpm-dmd-service): Rename to...
(%root-file-system-shepherd-service)
(file-system->shepherd-service-name, mapped-device->shepherd-service-name)
(dependency->shepherd-service-name, file-system-shepherd-service)
(mingetty-shepherd-service, nscd-shepherd-service, guix-shepherd-service)
(guix-publish-shepherd-service, udev-shepherd-service)
(gpm-shepherd-service): ... this.
* gnu/services/databases.scm (postgresql-dmd-service): Rename to...
(postgresql-shepherd-service): ... this.
* gnu/services/desktop.scm (upower-dmd-service, elogind-dmd-service):
Rename to...
(upower-shepherd-service, elogind-shepherd-service): ... this.
* gnu/services/dbus.scm (dbus-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/lirc.scm (lirc-dmd-service): Rename to...
(lirc-shepherd-service): ... this.
* gnu/services/mail.scm (dovecot-dmd-service): Rename to...
(dovecot-shepherd-service): ... this.
* gnu/services/networking.scm (ntp-dmd-service, tor-dmd-service)
(bitlbee-dmd-service, wicd-dmd-service, network-manager-dmd-service): Rename to...
(dbus-shepherd-service): ... this.
* gnu/services/ssh.scm (lsh-dmd-service): Rename to...
(lsh-shepherd-service): ... this.
* gnu/services/web.scm (nginx-dmd-service): Rename to...
(nginx-shepherd-service): ... this.
* gnu/services/xorg.scm (slim-dmd-service): Rename to...
(slim-shepherd-service): ... this.
* gnu/system.scm (essential-services): Use '%shepherd-root-service'.
* gnu/system/install.scm (cow-store-service-type): Adjust accordingly.
* guix/scripts/system.scm (dmd-service-node-label, dmd-service-node-type)
(export-dmd-graph): Likewise.
* tests/guix-system.sh: Likewise.
* tests/services.scm ("dmd-service-back-edges"): Rename to...
("shepherd-service-back-edges"): Adjust accordingly.
* doc/guix.texi: Likewise.
* doc/images/service-graph.dot: Use 'shepherd' service name.
This commit is contained in:
Alex Kost
parent
26b94866ad
commit
d4053c710b
20 changed files with 266 additions and 259 deletions
|
|
@ -9491,7 +9491,7 @@ with a simple example, the service type for the Guix build daemon
|
|||
(service-type
|
||||
(name 'guix)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type guix-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type guix-shepherd-service)
|
||||
(service-extension account-service-type guix-accounts)
|
||||
(service-extension activation-service-type guix-activation)))))
|
||||
@end example
|
||||
|
|
@ -9515,11 +9515,11 @@ exception is the @dfn{boot service type}, which is the ultimate service.
|
|||
In this example, @var{guix-service-type} extends three services:
|
||||
|
||||
@table @var
|
||||
@item dmd-root-service-type
|
||||
The @var{guix-dmd-service} procedure defines how the Shepherd service is
|
||||
extended. Namely, it returns a @code{<dmd-service>} object that defines
|
||||
how @command{guix-daemon} is started and stopped (@pxref{Shepherd
|
||||
Services}).
|
||||
@item shepherd-root-service-type
|
||||
The @var{guix-shepherd-service} procedure defines how the Shepherd
|
||||
service is extended. Namely, it returns a @code{<shepherd-service>}
|
||||
object that defines how @command{guix-daemon} is started and stopped
|
||||
(@pxref{Shepherd Services}).
|
||||
|
||||
@item account-service-type
|
||||
This extension for this service is computed by @var{guix-accounts},
|
||||
|
|
@ -9558,8 +9558,8 @@ The service type for an @emph{extensible} service looks like this:
|
|||
(define udev-service-type
|
||||
(service-type (name 'udev)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
udev-dmd-service)))
|
||||
(list (service-extension shepherd-root-service-type
|
||||
udev-shepherd-service)))
|
||||
|
||||
(compose concatenate) ;concatenate the list of rules
|
||||
(extend (lambda (config rules)
|
||||
|
|
@ -9573,7 +9573,7 @@ The service type for an @emph{extensible} service looks like this:
|
|||
This is the service type for the
|
||||
@uref{https://wiki.gentoo.org/wiki/Project:Eudev, eudev device
|
||||
management daemon}. Compared to the previous example, in addition to an
|
||||
extension of @var{dmd-root-service-type}, we see two new fields:
|
||||
extension of @var{shepherd-root-service-type}, we see two new fields:
|
||||
|
||||
@table @code
|
||||
@item compose
|
||||
|
|
@ -9801,11 +9801,11 @@ You can actually generate such a graph for any operating system
|
|||
definition using the @command{guix system dmd-graph} command
|
||||
(@pxref{system-dmd-graph, @command{guix system dmd-graph}}).
|
||||
|
||||
The @var{%dmd-root-service} is a service object representing PID@tie{}1,
|
||||
of type @var{dmd-root-service-type}; it can be extended by passing it
|
||||
lists of @code{<dmd-service>} objects.
|
||||
The @var{%shepherd-root-service} is a service object representing
|
||||
PID@tie{}1, of type @var{shepherd-root-service-type}; it can be extended
|
||||
by passing it lists of @code{<shepherd-service>} objects.
|
||||
|
||||
@deftp {Data Type} dmd-service
|
||||
@deftp {Data Type} shepherd-service
|
||||
The data type representing a service managed by the Shepherd.
|
||||
|
||||
@table @asis
|
||||
|
|
@ -9853,15 +9853,15 @@ the Shepherd.
|
|||
@end table
|
||||
@end deftp
|
||||
|
||||
@defvr {Scheme Variable} dmd-root-service-type
|
||||
@defvr {Scheme Variable} shepherd-root-service-type
|
||||
The service type for the Shepherd ``root service''---i.e., PID@tie{}1.
|
||||
|
||||
This is the service type that extensions target when they want to create
|
||||
shepherd services (@pxref{Service Types and Services}, for an example).
|
||||
Each extension must pass a list of @code{<dmd-service>}.
|
||||
Each extension must pass a list of @code{<shepherd-service>}.
|
||||
@end defvr
|
||||
|
||||
@defvr {Scheme Variable} %dmd-root-service
|
||||
@defvr {Scheme Variable} %shepherd-root-service
|
||||
This service represents PID@tie{}1.
|
||||
@end defvr
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
digraph "Service Type Dependencies" {
|
||||
dmd [shape = box, fontname = Helvetica];
|
||||
shepherd [shape = box, fontname = Helvetica];
|
||||
pam [shape = box, fontname = Helvetica];
|
||||
etc [shape = box, fontname = Helvetica];
|
||||
profile [shape = box, fontname = Helvetica];
|
||||
|
|
@ -7,14 +7,14 @@ digraph "Service Type Dependencies" {
|
|||
activation [shape = box, fontname = Helvetica];
|
||||
boot [shape = box, fontname = Helvetica];
|
||||
system [shape = house, fontname = Helvetica];
|
||||
lshd -> dmd;
|
||||
lshd -> shepherd;
|
||||
lshd -> pam;
|
||||
udev -> dmd;
|
||||
nscd -> dmd [label = "extends"];
|
||||
udev -> shepherd;
|
||||
nscd -> shepherd [label = "extends"];
|
||||
"nss-mdns" -> nscd;
|
||||
"kvm-rules" -> udev;
|
||||
colord -> udev;
|
||||
dbus -> dmd;
|
||||
dbus -> shepherd;
|
||||
colord -> dbus;
|
||||
upower -> udev;
|
||||
upower -> dbus;
|
||||
|
|
@ -23,7 +23,7 @@ digraph "Service Type Dependencies" {
|
|||
elogind -> dbus;
|
||||
elogind -> udev;
|
||||
elogind -> polkit [label = "extends"];
|
||||
dmd -> boot;
|
||||
shepherd -> boot;
|
||||
colord -> accounts;
|
||||
accounts -> activation;
|
||||
accounts -> etc;
|
||||
|
|
@ -31,7 +31,7 @@ digraph "Service Type Dependencies" {
|
|||
activation -> boot;
|
||||
pam -> etc;
|
||||
elogind -> pam;
|
||||
guix -> dmd;
|
||||
guix -> shepherd;
|
||||
guix -> activation;
|
||||
guix -> accounts;
|
||||
boot -> system;
|
||||
|
|
|
|||
|
|
@ -86,8 +86,8 @@ (define-module (gnu services)
|
|||
;;; A service type describe how its instances extend instances of other
|
||||
;;; service types. For instance, some services extend the instance of
|
||||
;;; ACCOUNT-SERVICE-TYPE by providing it with accounts and groups to create;
|
||||
;;; others extend DMD-ROOT-SERVICE-TYPE by passing it instances of
|
||||
;;; <dmd-service>.
|
||||
;;; others extend SHEPHERD-ROOT-SERVICE-TYPE by passing it instances of
|
||||
;;; <shepherd-service>.
|
||||
;;;
|
||||
;;; When applicable, the service type defines how it can itself be extended,
|
||||
;;; by providing one procedure to compose extensions, and one procedure to
|
||||
|
|
@ -209,7 +209,7 @@ (define system-service-type
|
|||
(define (compute-boot-script _ mexps)
|
||||
(mlet %store-monad ((gexps (sequence %store-monad mexps)))
|
||||
(gexp->file "boot"
|
||||
;; Clean up and activate the system, then spawn dmd.
|
||||
;; Clean up and activate the system, then spawn shepherd.
|
||||
#~(begin #$@gexps))))
|
||||
|
||||
(define (boot-script-entry mboot)
|
||||
|
|
|
|||
|
|
@ -93,11 +93,11 @@ (define %avahi-activation
|
|||
(use-modules (guix build utils))
|
||||
(mkdir-p "/var/run/avahi-daemon")))
|
||||
|
||||
(define (avahi-dmd-service config)
|
||||
"Return a list of <dmd-service> for CONFIG."
|
||||
(define (avahi-shepherd-service config)
|
||||
"Return a list of <shepherd-service> for CONFIG."
|
||||
(let ((config (configuration-file config))
|
||||
(avahi (avahi-configuration-avahi config)))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run the Avahi mDNS/DNS-SD responder.")
|
||||
(provision '(avahi-daemon))
|
||||
(requirement '(dbus-system networking))
|
||||
|
|
@ -111,8 +111,8 @@ (define avahi-service-type
|
|||
(let ((avahi-package (compose list avahi-configuration-avahi)))
|
||||
(service-type (name 'avahi)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
avahi-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
avahi-shepherd-service)
|
||||
(service-extension dbus-root-service-type
|
||||
avahi-package)
|
||||
(service-extension account-service-type
|
||||
|
|
|
|||
|
|
@ -148,8 +148,8 @@ (define fstab-service-type
|
|||
(compose identity)
|
||||
(extend append)))
|
||||
|
||||
(define %root-file-system-dmd-service
|
||||
(dmd-service
|
||||
(define %root-file-system-shepherd-service
|
||||
(shepherd-service
|
||||
(documentation "Take care of the root file system.")
|
||||
(provision '(root-file-system))
|
||||
(start #~(const #t))
|
||||
|
|
@ -181,37 +181,37 @@ (define %root-file-system-dmd-service
|
|||
(respawn? #f)))
|
||||
|
||||
(define root-file-system-service-type
|
||||
(dmd-service-type 'root-file-system
|
||||
(const %root-file-system-dmd-service)))
|
||||
(shepherd-service-type 'root-file-system
|
||||
(const %root-file-system-shepherd-service)))
|
||||
|
||||
(define (root-file-system-service)
|
||||
"Return a service whose sole purpose is to re-mount read-only the root file
|
||||
system upon shutdown (aka. cleanly \"umounting\" root.)
|
||||
|
||||
This service must be the root of the service dependency graph so that its
|
||||
'stop' action is invoked when dmd is the only process left."
|
||||
'stop' action is invoked when shepherd is the only process left."
|
||||
(service root-file-system-service-type #f))
|
||||
|
||||
(define (file-system->dmd-service-name file-system)
|
||||
(define (file-system->shepherd-service-name file-system)
|
||||
"Return the symbol that denotes the service mounting and unmounting
|
||||
FILE-SYSTEM."
|
||||
(symbol-append 'file-system-
|
||||
(string->symbol (file-system-mount-point file-system))))
|
||||
|
||||
(define (mapped-device->dmd-service-name md)
|
||||
"Return the symbol that denotes the dmd service of MD, a <mapped-device>."
|
||||
(define (mapped-device->shepherd-service-name md)
|
||||
"Return the symbol that denotes the shepherd service of MD, a <mapped-device>."
|
||||
(symbol-append 'device-mapping-
|
||||
(string->symbol (mapped-device-target md))))
|
||||
|
||||
(define dependency->dmd-service-name
|
||||
(define dependency->shepherd-service-name
|
||||
(match-lambda
|
||||
((? mapped-device? md)
|
||||
(mapped-device->dmd-service-name md))
|
||||
(mapped-device->shepherd-service-name md))
|
||||
((? file-system? fs)
|
||||
(file-system->dmd-service-name fs))))
|
||||
(file-system->shepherd-service-name fs))))
|
||||
|
||||
(define (file-system-dmd-service file-system)
|
||||
"Return a list containing the dmd service for @var{file-system}."
|
||||
(define (file-system-shepherd-service file-system)
|
||||
"Return a list containing the shepherd service for @var{file-system}."
|
||||
(let ((target (file-system-mount-point file-system))
|
||||
(device (file-system-device file-system))
|
||||
(type (file-system-type file-system))
|
||||
|
|
@ -221,10 +221,10 @@ (define (file-system-dmd-service file-system)
|
|||
(dependencies (file-system-dependencies file-system)))
|
||||
(if (file-system-mount? file-system)
|
||||
(list
|
||||
(dmd-service
|
||||
(provision (list (file-system->dmd-service-name file-system)))
|
||||
(shepherd-service
|
||||
(provision (list (file-system->shepherd-service-name file-system)))
|
||||
(requirement `(root-file-system
|
||||
,@(map dependency->dmd-service-name dependencies)))
|
||||
,@(map dependency->shepherd-service-name dependencies)))
|
||||
(documentation "Check, mount, and unmount the given file system.")
|
||||
(start #~(lambda args
|
||||
;; FIXME: Use or factorize with 'mount-file-system'.
|
||||
|
|
@ -276,11 +276,11 @@ (define (file-system-dmd-service file-system)
|
|||
|
||||
(define file-system-service-type
|
||||
;; TODO(?): Make this an extensible service that takes <file-system> objects
|
||||
;; and returns a list of <dmd-service>.
|
||||
;; and returns a list of <shepherd-service>.
|
||||
(service-type (name 'file-system)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
file-system-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
file-system-shepherd-service)
|
||||
(service-extension fstab-service-type
|
||||
identity)))))
|
||||
|
||||
|
|
@ -290,10 +290,10 @@ (define* (file-system-service file-system)
|
|||
(service file-system-service-type file-system))
|
||||
|
||||
(define user-unmount-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'user-file-systems
|
||||
(lambda (known-mount-points)
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "Unmount manually-mounted file systems.")
|
||||
(provision '(user-file-systems))
|
||||
(start #~(const #t))
|
||||
|
|
@ -328,15 +328,15 @@ (define %do-not-kill-file
|
|||
"/etc/shepherd/do-not-kill")
|
||||
|
||||
(define user-processes-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'user-processes
|
||||
(match-lambda
|
||||
((requirements grace-delay)
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "When stopped, terminate all user processes.")
|
||||
(provision '(user-processes))
|
||||
(requirement (cons* 'root-file-system 'user-file-systems
|
||||
(map file-system->dmd-service-name
|
||||
(map file-system->shepherd-service-name
|
||||
requirements)))
|
||||
(start #~(const #t))
|
||||
(stop #~(lambda _
|
||||
|
|
@ -410,7 +410,7 @@ (define* (user-processes-service file-systems #:key (grace-delay 4))
|
|||
rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM
|
||||
has been sent are terminated with SIGKILL.
|
||||
|
||||
The returned service will depend on 'root-file-system' and on all the dmd
|
||||
The returned service will depend on 'root-file-system' and on all the shepherd
|
||||
services corresponding to FILE-SYSTEMS.
|
||||
|
||||
All the services that spawn processes must depend on this one so that they are
|
||||
|
|
@ -457,10 +457,10 @@ (define (session-environment-service vars)
|
|||
;;;
|
||||
|
||||
(define host-name-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'host-name
|
||||
(lambda (name)
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "Initialize the machine's host name.")
|
||||
(provision '(host-name))
|
||||
(start #~(lambda _
|
||||
|
|
@ -490,10 +490,10 @@ (define (unicode-start tty)
|
|||
(zero? (cdr (waitpid pid))))))))
|
||||
|
||||
(define console-keymap-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'console-keymap
|
||||
(lambda (file)
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation (string-append "Load console keymap (loadkeys)."))
|
||||
(provision '(console-keymap))
|
||||
(start #~(lambda _
|
||||
|
|
@ -506,12 +506,12 @@ (define (console-keymap-service file)
|
|||
(service console-keymap-service-type file))
|
||||
|
||||
(define console-font-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'console-font
|
||||
(match-lambda
|
||||
((tty font)
|
||||
(let ((device (string-append "/dev/" tty)))
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "Load a Unicode console font.")
|
||||
(provision (list (symbol-append 'console-font-
|
||||
(string->symbol tty))))
|
||||
|
|
@ -568,12 +568,12 @@ (define (mingetty-pam-service conf)
|
|||
#:motd
|
||||
(mingetty-configuration-motd conf))))
|
||||
|
||||
(define mingetty-dmd-service
|
||||
(define mingetty-shepherd-service
|
||||
(match-lambda
|
||||
(($ <mingetty-configuration> mingetty tty motd auto-login login-program
|
||||
login-pause? allow-empty-passwords?)
|
||||
(list
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "Run mingetty on an tty.")
|
||||
(provision (list (symbol-append 'term- (string->symbol tty))))
|
||||
|
||||
|
|
@ -598,8 +598,8 @@ (define mingetty-dmd-service
|
|||
|
||||
(define mingetty-service-type
|
||||
(service-type (name 'mingetty)
|
||||
(extensions (list (service-extension dmd-root-service-type
|
||||
mingetty-dmd-service)
|
||||
(extensions (list (service-extension shepherd-root-service-type
|
||||
mingetty-shepherd-service)
|
||||
(service-extension pam-root-service-type
|
||||
mingetty-pam-service)))))
|
||||
|
||||
|
|
@ -711,11 +711,11 @@ (define cache->config
|
|||
(string-concatenate
|
||||
(map cache->config caches)))))))
|
||||
|
||||
(define (nscd-dmd-service config)
|
||||
"Return a dmd service for CONFIG, an <nscd-configuration> object."
|
||||
(define (nscd-shepherd-service config)
|
||||
"Return a shepherd service for CONFIG, an <nscd-configuration> object."
|
||||
(let ((nscd.conf (nscd.conf-file config))
|
||||
(name-services (nscd-configuration-name-services config)))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run libc's name service cache daemon (nscd).")
|
||||
(provision '(nscd))
|
||||
(requirement '(user-processes))
|
||||
|
|
@ -747,8 +747,8 @@ (define nscd-service-type
|
|||
(extensions
|
||||
(list (service-extension activation-service-type
|
||||
(const nscd-activation))
|
||||
(service-extension dmd-root-service-type
|
||||
nscd-dmd-service)))
|
||||
(service-extension shepherd-root-service-type
|
||||
nscd-shepherd-service)))
|
||||
|
||||
;; This can be extended by providing additional name services
|
||||
;; such as nss-mdns.
|
||||
|
|
@ -767,10 +767,10 @@ (define* (nscd-service #:optional (config %nscd-default-configuration))
|
|||
(service nscd-service-type config))
|
||||
|
||||
(define syslog-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'syslog
|
||||
(lambda (config-file)
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "Run the syslog daemon (syslogd).")
|
||||
(provision '(syslogd))
|
||||
(requirement '(user-processes))
|
||||
|
|
@ -885,13 +885,13 @@ (define-record-type* <guix-configuration>
|
|||
(define %default-guix-configuration
|
||||
(guix-configuration))
|
||||
|
||||
(define (guix-dmd-service config)
|
||||
"Return a <dmd-service> for the Guix daemon service with CONFIG."
|
||||
(define (guix-shepherd-service config)
|
||||
"Return a <shepherd-service> for the Guix daemon service with CONFIG."
|
||||
(match config
|
||||
(($ <guix-configuration> guix build-group build-accounts authorize-key?
|
||||
use-substitutes? substitute-urls extra-options
|
||||
lsof lsh)
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run the Guix daemon.")
|
||||
(provision '(guix-daemon))
|
||||
(requirement '(user-processes))
|
||||
|
|
@ -941,7 +941,7 @@ (define guix-service-type
|
|||
(service-type
|
||||
(name 'guix)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type guix-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type guix-shepherd-service)
|
||||
(service-extension account-service-type guix-accounts)
|
||||
(service-extension activation-service-type guix-activation)
|
||||
(service-extension profile-service-type
|
||||
|
|
@ -963,10 +963,10 @@ (define-record-type* <guix-publish-configuration>
|
|||
(host guix-publish-configuration-host ;string
|
||||
(default "localhost")))
|
||||
|
||||
(define guix-publish-dmd-service
|
||||
(define guix-publish-shepherd-service
|
||||
(match-lambda
|
||||
(($ <guix-publish-configuration> guix port host)
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(guix-publish))
|
||||
(requirement '(guix-daemon))
|
||||
(start #~(make-forkexec-constructor
|
||||
|
|
@ -989,8 +989,8 @@ (define %guix-publish-accounts
|
|||
(define guix-publish-service-type
|
||||
(service-type (name 'guix-publish)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
guix-publish-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
guix-publish-shepherd-service)
|
||||
(service-extension account-service-type
|
||||
(const %guix-publish-accounts))))))
|
||||
|
||||
|
|
@ -1070,8 +1070,8 @@ (define kvm-udev-rule
|
|||
(udev-rule "90-kvm.rules"
|
||||
"KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n"))
|
||||
|
||||
(define udev-dmd-service
|
||||
;; Return a <dmd-service> for UDEV with RULES.
|
||||
(define udev-shepherd-service
|
||||
;; Return a <shepherd-service> for UDEV with RULES.
|
||||
(match-lambda
|
||||
(($ <udev-configuration> udev rules)
|
||||
(let* ((rules (udev-rules-union (cons* udev kvm-udev-rule rules)))
|
||||
|
|
@ -1082,7 +1082,7 @@ (define udev-dmd-service
|
|||
"udev_rules=\"~a/lib/udev/rules.d\"\n"
|
||||
#$rules))))))
|
||||
(list
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(provision '(udev))
|
||||
|
||||
;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
|
||||
|
|
@ -1154,8 +1154,8 @@ (define (wait-for-udevd)
|
|||
(define udev-service-type
|
||||
(service-type (name 'udev)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
udev-dmd-service)))
|
||||
(list (service-extension shepherd-root-service-type
|
||||
udev-shepherd-service)))
|
||||
|
||||
(compose concatenate) ;concatenate the list of rules
|
||||
(extend (lambda (config rules)
|
||||
|
|
@ -1172,11 +1172,11 @@ (define* (udev-service #:key (udev eudev) (rules '()))
|
|||
(udev-configuration (udev udev) (rules rules))))
|
||||
|
||||
(define device-mapping-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'device-mapping
|
||||
(match-lambda
|
||||
((target open close)
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(provision (list (symbol-append 'device-mapping- (string->symbol target))))
|
||||
(requirement '(udev))
|
||||
(documentation "Map a device node using Linux's device mapper.")
|
||||
|
|
@ -1192,7 +1192,7 @@ (define (device-mapping-service target open close)
|
|||
(list target open close)))
|
||||
|
||||
(define swap-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'swap
|
||||
(lambda (device)
|
||||
(define requirement
|
||||
|
|
@ -1201,7 +1201,7 @@ (define requirement
|
|||
(string->symbol (basename device))))
|
||||
'()))
|
||||
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(provision (list (symbol-append 'swap- (string->symbol device))))
|
||||
(requirement `(udev ,@requirement))
|
||||
(documentation "Enable the given swap device.")
|
||||
|
|
@ -1223,10 +1223,10 @@ (define-record-type* <gpm-configuration>
|
|||
(gpm gpm-configuration-gpm) ;package
|
||||
(options gpm-configuration-options)) ;list of strings
|
||||
|
||||
(define gpm-dmd-service
|
||||
(define gpm-shepherd-service
|
||||
(match-lambda
|
||||
(($ <gpm-configuration> gpm options)
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(requirement '(udev))
|
||||
(provision '(gpm))
|
||||
(start #~(lambda ()
|
||||
|
|
@ -1254,8 +1254,8 @@ (define gpm-dmd-service
|
|||
(define gpm-service-type
|
||||
(service-type (name 'gpm)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
gpm-dmd-service)))))
|
||||
(list (service-extension shepherd-root-service-type
|
||||
gpm-shepherd-service)))))
|
||||
|
||||
(define* (gpm-service #:key (gpm gpm)
|
||||
(options '("-m" "/dev/input/mice" "-t" "ps2")))
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@ (define postgresql-activation
|
|||
(primitive-exit 1))))
|
||||
(pid (waitpid pid))))))))
|
||||
|
||||
(define postgresql-dmd-service
|
||||
(define postgresql-shepherd-service
|
||||
(match-lambda
|
||||
(($ <postgresql-configuration> postgresql config-file data-directory)
|
||||
(let ((start-script
|
||||
|
|
@ -112,7 +112,7 @@ (define postgresql-dmd-service
|
|||
(string-append "--config-file="
|
||||
#$config-file)
|
||||
"-D" #$data-directory)))))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(postgres))
|
||||
(documentation "Run the PostgreSQL daemon.")
|
||||
(requirement '(user-processes loopback))
|
||||
|
|
@ -122,8 +122,8 @@ (define postgresql-dmd-service
|
|||
(define postgresql-service-type
|
||||
(service-type (name 'postgresql)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
postgresql-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
postgresql-shepherd-service)
|
||||
(service-extension activation-service-type
|
||||
postgresql-activation)
|
||||
(service-extension account-service-type
|
||||
|
|
|
|||
|
|
@ -159,10 +159,10 @@ (define (dbus-activation config)
|
|||
(execl prog)))
|
||||
(waitpid pid)))))))
|
||||
|
||||
(define dbus-dmd-service
|
||||
(define dbus-shepherd-service
|
||||
(match-lambda
|
||||
(($ <dbus-configuration> dbus)
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run the D-Bus system daemon.")
|
||||
(provision '(dbus-system))
|
||||
(requirement '(user-processes))
|
||||
|
|
@ -174,8 +174,8 @@ (define dbus-dmd-service
|
|||
(define dbus-root-service-type
|
||||
(service-type (name 'dbus)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
dbus-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
dbus-shepherd-service)
|
||||
(service-extension activation-service-type
|
||||
dbus-activation)
|
||||
(service-extension etc-service-type
|
||||
|
|
|
|||
|
|
@ -165,11 +165,11 @@ (define (upower-dbus-service config)
|
|||
"UPOWER_CONF_FILE_NAME"
|
||||
(upower-configuration-file config))))
|
||||
|
||||
(define (upower-dmd-service config)
|
||||
"Return a dmd service for UPower with CONFIG."
|
||||
(define (upower-shepherd-service config)
|
||||
"Return a shepherd service for UPower with CONFIG."
|
||||
(let ((upower (upower-configuration-upower config))
|
||||
(config (upower-configuration-file config)))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run the UPower power and battery monitor.")
|
||||
(provision '(upower-daemon))
|
||||
(requirement '(dbus-system udev))
|
||||
|
|
@ -186,8 +186,8 @@ (define upower-service-type
|
|||
(extensions
|
||||
(list (service-extension dbus-root-service-type
|
||||
upower-dbus-service)
|
||||
(service-extension dmd-root-service-type
|
||||
upower-dmd-service)
|
||||
(service-extension shepherd-root-service-type
|
||||
upower-shepherd-service)
|
||||
(service-extension activation-service-type
|
||||
(const %upower-activation))
|
||||
(service-extension udev-service-type
|
||||
|
|
@ -644,13 +644,13 @@ (define-syntax-rule (ini-file config file clause ...)
|
|||
("HybridSleepState" (sleep-list elogind-hybrid-sleep-state))
|
||||
("HybridSleepMode" (sleep-list elogind-hybrid-sleep-mode))))
|
||||
|
||||
(define (elogind-dmd-service config)
|
||||
"Return a dmd service for elogind, using @var{config}."
|
||||
(define (elogind-shepherd-service config)
|
||||
"Return a shepherd service for elogind, using @var{config}."
|
||||
;; TODO: We could probably rely on service activation but the '.service'
|
||||
;; file currently contains an erroneous 'Exec' line.
|
||||
(let ((config-file (elogind-configuration-file config))
|
||||
(elogind (elogind-package config)))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run the elogind login and seat management service.")
|
||||
(provision '(elogind))
|
||||
(requirement '(dbus-system))
|
||||
|
|
@ -664,8 +664,8 @@ (define (elogind-dmd-service config)
|
|||
(define elogind-service-type
|
||||
(service-type (name 'elogind)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
elogind-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
elogind-shepherd-service)
|
||||
(service-extension dbus-root-service-type
|
||||
(compose list elogind-package))
|
||||
(service-extension udev-service-type
|
||||
|
|
|
|||
|
|
@ -48,10 +48,10 @@ (define %lirc-activation
|
|||
(use-modules (guix build utils))
|
||||
(mkdir-p "/var/run/lirc")))
|
||||
|
||||
(define lirc-dmd-service
|
||||
(define lirc-shepherd-service
|
||||
(match-lambda
|
||||
(($ <lirc-configuration> lirc device driver config-file options)
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(lircd))
|
||||
(documentation "Run the LIRC daemon.")
|
||||
(requirement '(user-processes))
|
||||
|
|
@ -73,8 +73,8 @@ (define lirc-dmd-service
|
|||
(define lirc-service-type
|
||||
(service-type (name 'lirc)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
lirc-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
lirc-shepherd-service)
|
||||
(service-extension activation-service-type
|
||||
(const %lirc-activation))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1574,8 +1574,8 @@ (define* (create-self-signed-certificate-if-absent
|
|||
#:owner (getpwnam "root")
|
||||
#:common-name (format #f "Dovecot service on ~a" (gethostname))))))
|
||||
|
||||
(define (dovecot-dmd-service config)
|
||||
"Return a list of <dmd-service> for CONFIG."
|
||||
(define (dovecot-shepherd-service config)
|
||||
"Return a list of <shepherd-service> for CONFIG."
|
||||
(let* ((config-str
|
||||
(cond
|
||||
((opaque-dovecot-configuration? config)
|
||||
|
|
@ -1589,7 +1589,7 @@ (define (dovecot-dmd-service config)
|
|||
(dovecot (if (opaque-dovecot-configuration? config)
|
||||
(opaque-dovecot-configuration-dovecot config)
|
||||
(dovecot-configuration-dovecot config))))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Run the Dovecot POP3/IMAP mail server.")
|
||||
(provision '(dovecot))
|
||||
(requirement '(networking))
|
||||
|
|
@ -1606,8 +1606,8 @@ (define %dovecot-pam-services
|
|||
(define dovecot-service-type
|
||||
(service-type (name 'dovecot)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
dovecot-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
dovecot-shepherd-service)
|
||||
(service-extension account-service-type
|
||||
(const %dovecot-accounts))
|
||||
(service-extension pam-root-service-type
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ (define-record-type* <static-networking>
|
|||
(net-tools static-networking-net-tools))
|
||||
|
||||
(define static-networking-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'static-networking
|
||||
(match-lambda
|
||||
(($ <static-networking> interface ip gateway provision
|
||||
|
|
@ -107,7 +107,7 @@ (define static-networking-service-type
|
|||
|
||||
;; TODO: Eventually replace 'route' with bindings for the appropriate
|
||||
;; ioctls.
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
|
||||
;; Unless we're providing the loopback interface, wait for udev to be up
|
||||
;; and running so that INTERFACE is actually usable.
|
||||
|
|
@ -171,7 +171,7 @@ (define* (static-networking-service interface ip
|
|||
(net-tools net-tools))))
|
||||
|
||||
(define dhcp-client-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'dhcp-client
|
||||
(lambda (dhcp)
|
||||
(define dhclient
|
||||
|
|
@ -180,7 +180,7 @@ (define dhclient
|
|||
(define pid-file
|
||||
"/var/run/dhclient.pid")
|
||||
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(documentation "Set up networking via DHCP.")
|
||||
(requirement '(user-processes udev))
|
||||
|
||||
|
|
@ -248,7 +248,7 @@ (define-record-type* <ntp-configuration>
|
|||
(default ntp))
|
||||
(servers ntp-configuration-servers))
|
||||
|
||||
(define ntp-dmd-service
|
||||
(define ntp-shepherd-service
|
||||
(match-lambda
|
||||
(($ <ntp-configuration> ntp servers)
|
||||
(let ()
|
||||
|
|
@ -271,7 +271,7 @@ (define config
|
|||
(define ntpd.conf
|
||||
(plain-file "ntpd.conf" config))
|
||||
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(ntpd))
|
||||
(documentation "Run the Network Time Protocol (NTP) daemon.")
|
||||
(requirement '(user-processes networking))
|
||||
|
|
@ -292,8 +292,8 @@ (define %ntp-accounts
|
|||
(define ntp-service-type
|
||||
(service-type (name 'ntp)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
ntp-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
ntp-shepherd-service)
|
||||
(service-extension account-service-type
|
||||
(const %ntp-accounts))))))
|
||||
|
||||
|
|
@ -376,12 +376,12 @@ (define (tor-configuration->torrc config)
|
|||
#t)))
|
||||
#:modules '((guix build utils))))))
|
||||
|
||||
(define (tor-dmd-service config)
|
||||
"Return a <dmd-service> running TOR."
|
||||
(define (tor-shepherd-service config)
|
||||
"Return a <shepherd-service> running TOR."
|
||||
(match config
|
||||
(($ <tor-configuration> tor)
|
||||
(let ((torrc (tor-configuration->torrc config)))
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(tor))
|
||||
|
||||
;; Tor needs at least one network interface to be up, hence the
|
||||
|
|
@ -421,8 +421,8 @@ (define (initialize service)
|
|||
(define tor-service-type
|
||||
(service-type (name 'tor)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
tor-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
tor-shepherd-service)
|
||||
(service-extension account-service-type
|
||||
(const %tor-accounts))
|
||||
(service-extension activation-service-type
|
||||
|
|
@ -492,7 +492,7 @@ (define-record-type* <bitlbee-configuration>
|
|||
(port bitlbee-configuration-port)
|
||||
(extra-settings bitlbee-configuration-extra-settings))
|
||||
|
||||
(define bitlbee-dmd-service
|
||||
(define bitlbee-shepherd-service
|
||||
(match-lambda
|
||||
(($ <bitlbee-configuration> bitlbee interface port extra-settings)
|
||||
(let ((conf (plain-file "bitlbee.conf"
|
||||
|
|
@ -504,7 +504,7 @@ (define bitlbee-dmd-service
|
|||
DaemonPort = " (number->string port) "
|
||||
" extra-settings))))
|
||||
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(bitlbee))
|
||||
(requirement '(user-processes loopback))
|
||||
(start #~(make-forkexec-constructor
|
||||
|
|
@ -537,8 +537,8 @@ (define %bitlbee-activation
|
|||
(define bitlbee-service-type
|
||||
(service-type (name 'bitlbee)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
bitlbee-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
bitlbee-shepherd-service)
|
||||
(service-extension account-service-type
|
||||
(const %bitlbee-accounts))
|
||||
(service-extension activation-service-type
|
||||
|
|
@ -579,9 +579,9 @@ (define %wicd-activation
|
|||
(copy-file (string-append #$wicd file-name)
|
||||
file-name)))))
|
||||
|
||||
(define (wicd-dmd-service wicd)
|
||||
"Return a dmd service for WICD."
|
||||
(list (dmd-service
|
||||
(define (wicd-shepherd-service wicd)
|
||||
"Return a shepherd service for WICD."
|
||||
(list (shepherd-service
|
||||
(documentation "Run the Wicd network manager.")
|
||||
(provision '(networking))
|
||||
(requirement '(user-processes dbus-system loopback))
|
||||
|
|
@ -593,8 +593,8 @@ (define (wicd-dmd-service wicd)
|
|||
(define wicd-service-type
|
||||
(service-type (name 'wicd)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
wicd-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
wicd-shepherd-service)
|
||||
(service-extension dbus-root-service-type
|
||||
list)
|
||||
(service-extension activation-service-type
|
||||
|
|
@ -624,9 +624,9 @@ (define %network-manager-activation
|
|||
(use-modules (guix build utils))
|
||||
(mkdir-p "/etc/NetworkManager/system-connections")))
|
||||
|
||||
(define (network-manager-dmd-service network-manager)
|
||||
"Return a dmd service for NETWORK-MANAGER."
|
||||
(list (dmd-service
|
||||
(define (network-manager-shepherd-service network-manager)
|
||||
"Return a shepherd service for NETWORK-MANAGER."
|
||||
(list (shepherd-service
|
||||
(documentation "Run the NetworkManager.")
|
||||
(provision '(networking))
|
||||
(requirement '(user-processes dbus-system loopback))
|
||||
|
|
@ -639,8 +639,8 @@ (define (network-manager-dmd-service network-manager)
|
|||
(define network-manager-service-type
|
||||
(service-type (name 'network-manager)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
network-manager-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
network-manager-shepherd-service)
|
||||
(service-extension dbus-root-service-type list)
|
||||
(service-extension activation-service-type
|
||||
(const %network-manager-activation))
|
||||
|
|
|
|||
|
|
@ -32,26 +32,26 @@ (define-module (gnu services shepherd)
|
|||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:export (dmd-root-service-type
|
||||
%dmd-root-service
|
||||
dmd-service-type
|
||||
#:export (shepherd-root-service-type
|
||||
%shepherd-root-service
|
||||
shepherd-service-type
|
||||
|
||||
dmd-service
|
||||
dmd-service?
|
||||
dmd-service-documentation
|
||||
dmd-service-provision
|
||||
dmd-service-requirement
|
||||
dmd-service-respawn?
|
||||
dmd-service-start
|
||||
dmd-service-stop
|
||||
dmd-service-auto-start?
|
||||
dmd-service-modules
|
||||
dmd-service-imported-modules
|
||||
shepherd-service
|
||||
shepherd-service?
|
||||
shepherd-service-documentation
|
||||
shepherd-service-provision
|
||||
shepherd-service-requirement
|
||||
shepherd-service-respawn?
|
||||
shepherd-service-start
|
||||
shepherd-service-stop
|
||||
shepherd-service-auto-start?
|
||||
shepherd-service-modules
|
||||
shepherd-service-imported-modules
|
||||
|
||||
%default-imported-modules
|
||||
%default-modules
|
||||
|
||||
dmd-service-back-edges))
|
||||
shepherd-service-back-edges))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -60,7 +60,7 @@ (define-module (gnu services shepherd)
|
|||
;;; Code:
|
||||
|
||||
|
||||
(define (dmd-boot-gexp services)
|
||||
(define (shepherd-boot-gexp services)
|
||||
(mlet %store-monad ((shepherd-conf (shepherd-configuration-file services)))
|
||||
(return #~(begin
|
||||
;; Keep track of the booted system.
|
||||
|
|
@ -81,29 +81,30 @@ (define (dmd-boot-gexp services)
|
|||
(execl (string-append #$shepherd "/bin/shepherd")
|
||||
"shepherd" "--config" #$shepherd-conf)))))
|
||||
|
||||
(define dmd-root-service-type
|
||||
(define shepherd-root-service-type
|
||||
(service-type
|
||||
(name 'dmd-root)
|
||||
;; Extending the root dmd service (aka. PID 1) happens by concatenating the
|
||||
;; list of services provided by the extensions.
|
||||
(name 'shepherd-root)
|
||||
;; Extending the root shepherd service (aka. PID 1) happens by
|
||||
;; concatenating the list of services provided by the extensions.
|
||||
(compose concatenate)
|
||||
(extend append)
|
||||
(extensions (list (service-extension boot-service-type dmd-boot-gexp)
|
||||
(extensions (list (service-extension boot-service-type
|
||||
shepherd-boot-gexp)
|
||||
(service-extension profile-service-type
|
||||
(const (list shepherd)))))))
|
||||
|
||||
(define %dmd-root-service
|
||||
;; The root dmd service, aka. PID 1. Its parameter is a list of
|
||||
;; <dmd-service> objects.
|
||||
(service dmd-root-service-type '()))
|
||||
(define %shepherd-root-service
|
||||
;; The root shepherd service, aka. PID 1. Its parameter is a list of
|
||||
;; <shepherd-service> objects.
|
||||
(service shepherd-root-service-type '()))
|
||||
|
||||
(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."
|
||||
(define-syntax-rule (shepherd-service-type service-name proc)
|
||||
"Return a <service-type> denoting a simple shepherd service--i.e., the type
|
||||
for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else."
|
||||
(service-type
|
||||
(name service-name)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
(list (service-extension shepherd-root-service-type
|
||||
(compose list proc))))))
|
||||
|
||||
(define %default-imported-modules
|
||||
|
|
@ -118,35 +119,35 @@ (define %default-modules
|
|||
(guix build utils)
|
||||
(guix build syscalls)))
|
||||
|
||||
(define-record-type* <dmd-service>
|
||||
dmd-service make-dmd-service
|
||||
dmd-service?
|
||||
(documentation dmd-service-documentation ;string
|
||||
(define-record-type* <shepherd-service>
|
||||
shepherd-service make-shepherd-service
|
||||
shepherd-service?
|
||||
(documentation shepherd-service-documentation ;string
|
||||
(default "[No documentation.]"))
|
||||
(provision dmd-service-provision) ;list of symbols
|
||||
(requirement dmd-service-requirement ;list of symbols
|
||||
(provision shepherd-service-provision) ;list of symbols
|
||||
(requirement shepherd-service-requirement ;list of symbols
|
||||
(default '()))
|
||||
(respawn? dmd-service-respawn? ;Boolean
|
||||
(respawn? shepherd-service-respawn? ;Boolean
|
||||
(default #t))
|
||||
(start dmd-service-start) ;g-expression (procedure)
|
||||
(stop dmd-service-stop ;g-expression (procedure)
|
||||
(start shepherd-service-start) ;g-expression (procedure)
|
||||
(stop shepherd-service-stop ;g-expression (procedure)
|
||||
(default #~(const #f)))
|
||||
(auto-start? dmd-service-auto-start? ;Boolean
|
||||
(auto-start? shepherd-service-auto-start? ;Boolean
|
||||
(default #t))
|
||||
(modules dmd-service-modules ;list of module names
|
||||
(modules shepherd-service-modules ;list of module names
|
||||
(default %default-modules))
|
||||
(imported-modules dmd-service-imported-modules ;list of module names
|
||||
(imported-modules shepherd-service-imported-modules ;list of module names
|
||||
(default %default-imported-modules)))
|
||||
|
||||
|
||||
(define (assert-valid-graph services)
|
||||
"Raise an error if SERVICES does not define a valid dmd service graph, for
|
||||
instance if a service requires a nonexistent service, or if more than one
|
||||
"Raise an error if SERVICES does not define a valid shepherd service graph,
|
||||
for instance if a service requires a nonexistent service, or if more than one
|
||||
service uses a given name.
|
||||
|
||||
These are constraints that dmd's 'register-service' verifies but we'd better
|
||||
verify them here statically than wait until PID 1 halts with an assertion
|
||||
failure."
|
||||
These are constraints that shepherd's 'register-service' verifies but we'd
|
||||
better verify them here statically than wait until PID 1 halts with an
|
||||
assertion failure."
|
||||
(define provisions
|
||||
;; The set of provisions (symbols). Bail out if a symbol is given more
|
||||
;; than once.
|
||||
|
|
@ -159,9 +160,9 @@ (define (assert-unique symbol)
|
|||
(format #f (_ "service '~a' provided more than once")
|
||||
symbol)))))))
|
||||
|
||||
(for-each assert-unique (dmd-service-provision service))
|
||||
(fold set-insert set (dmd-service-provision service)))
|
||||
(setq 'dmd)
|
||||
(for-each assert-unique (shepherd-service-provision service))
|
||||
(fold set-insert set (shepherd-service-provision service)))
|
||||
(setq 'shepherd)
|
||||
services))
|
||||
|
||||
(define (assert-satisfied-requirements service)
|
||||
|
|
@ -173,51 +174,53 @@ (define (assert-satisfied-requirements service)
|
|||
(message
|
||||
(format #f (_ "service '~a' requires '~a', \
|
||||
which is undefined")
|
||||
(match (dmd-service-provision service)
|
||||
(match (shepherd-service-provision service)
|
||||
((head . _) head)
|
||||
(_ service))
|
||||
requirement)))))))
|
||||
(dmd-service-requirement service)))
|
||||
(shepherd-service-requirement service)))
|
||||
|
||||
(for-each assert-satisfied-requirements services))
|
||||
|
||||
(define (dmd-service-file-name service)
|
||||
(define (shepherd-service-file-name service)
|
||||
"Return the file name where the initialization code for SERVICE is to be
|
||||
stored."
|
||||
(let ((provisions (string-join (map symbol->string
|
||||
(dmd-service-provision service)))))
|
||||
(string-append "dmd-"
|
||||
(shepherd-service-provision service)))))
|
||||
(string-append "shepherd-"
|
||||
(string-map (match-lambda
|
||||
(#\/ #\-)
|
||||
(chr chr))
|
||||
provisions)
|
||||
".scm")))
|
||||
|
||||
(define (dmd-service-file service)
|
||||
(define (shepherd-service-file service)
|
||||
"Return a file defining SERVICE."
|
||||
(gexp->file (dmd-service-file-name service)
|
||||
(gexp->file (shepherd-service-file-name service)
|
||||
#~(begin
|
||||
(use-modules #$@(dmd-service-modules service))
|
||||
(use-modules #$@(shepherd-service-modules service))
|
||||
|
||||
(make <service>
|
||||
#:docstring '#$(dmd-service-documentation service)
|
||||
#:provides '#$(dmd-service-provision service)
|
||||
#:requires '#$(dmd-service-requirement service)
|
||||
#:respawn? '#$(dmd-service-respawn? service)
|
||||
#:start #$(dmd-service-start service)
|
||||
#:stop #$(dmd-service-stop service)))))
|
||||
#:docstring '#$(shepherd-service-documentation service)
|
||||
#:provides '#$(shepherd-service-provision service)
|
||||
#:requires '#$(shepherd-service-requirement service)
|
||||
#:respawn? '#$(shepherd-service-respawn? service)
|
||||
#:start #$(shepherd-service-start service)
|
||||
#:stop #$(shepherd-service-stop service)))))
|
||||
|
||||
(define (shepherd-configuration-file services)
|
||||
"Return the shepherd configuration file for SERVICES."
|
||||
(define modules
|
||||
(delete-duplicates
|
||||
(append-map dmd-service-imported-modules services)))
|
||||
(append-map shepherd-service-imported-modules services)))
|
||||
|
||||
(assert-valid-graph services)
|
||||
|
||||
(mlet %store-monad ((modules (imported-modules modules))
|
||||
(compiled (compiled-modules modules))
|
||||
(files (mapm %store-monad dmd-service-file services)))
|
||||
(files (mapm %store-monad
|
||||
shepherd-service-file
|
||||
services)))
|
||||
(define config
|
||||
#~(begin
|
||||
(eval-when (expand load eval)
|
||||
|
|
@ -238,20 +241,20 @@ (define config
|
|||
|
||||
(format #t "starting services...~%")
|
||||
(for-each start
|
||||
'#$(append-map dmd-service-provision
|
||||
(filter dmd-service-auto-start?
|
||||
'#$(append-map shepherd-service-provision
|
||||
(filter shepherd-service-auto-start?
|
||||
services)))))
|
||||
|
||||
(gexp->file "shepherd.conf" config)))
|
||||
|
||||
(define (dmd-service-back-edges services)
|
||||
"Return a procedure that, when given a <dmd-service> from SERVICES, returns
|
||||
the list of <dmd-service> that depend on it."
|
||||
(define (shepherd-service-back-edges services)
|
||||
"Return a procedure that, when given a <shepherd-service> from SERVICES,
|
||||
returns the list of <shepherd-service> that depend on it."
|
||||
(define provision->service
|
||||
(let ((services (fold (lambda (service result)
|
||||
(fold (cut vhash-consq <> service <>)
|
||||
result
|
||||
(dmd-service-provision service)))
|
||||
(shepherd-service-provision service)))
|
||||
vlist-null
|
||||
services)))
|
||||
(lambda (name)
|
||||
|
|
@ -265,7 +268,7 @@ (define edges
|
|||
(vhash-consq (provision->service requirement) service
|
||||
edges))
|
||||
edges
|
||||
(dmd-service-requirement service)))
|
||||
(shepherd-service-requirement service)))
|
||||
vlist-null
|
||||
services))
|
||||
|
||||
|
|
|
|||
|
|
@ -103,8 +103,8 @@ (define (lsh-activation config)
|
|||
(lsh-configuration-host-key config))
|
||||
#t)))
|
||||
|
||||
(define (lsh-dmd-service config)
|
||||
"Return a <dmd-service> for lsh with CONFIG."
|
||||
(define (lsh-shepherd-service config)
|
||||
"Return a <shepherd-service> for lsh with CONFIG."
|
||||
(define lsh (lsh-configuration-lsh config))
|
||||
(define pid-file (lsh-configuration-pid-file config))
|
||||
(define pid-file? (lsh-configuration-pid-file? config))
|
||||
|
|
@ -151,7 +151,7 @@ (define requires
|
|||
'(networking syslogd)
|
||||
'(networking)))
|
||||
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "GNU lsh SSH server")
|
||||
(provision '(ssh-daemon))
|
||||
(requirement requires)
|
||||
|
|
@ -168,8 +168,8 @@ (define (lsh-pam-services config)
|
|||
(define lsh-service-type
|
||||
(service-type (name 'lsh)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
lsh-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
lsh-shepherd-service)
|
||||
(service-extension pam-root-service-type
|
||||
lsh-pam-services)
|
||||
(service-extension activation-service-type
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ (define nginx-activation
|
|||
(system* (string-append #$nginx "/bin/nginx")
|
||||
"-c" #$config-file "-t")))))
|
||||
|
||||
(define nginx-dmd-service
|
||||
(define nginx-shepherd-service
|
||||
(match-lambda
|
||||
(($ <nginx-configuration> nginx log-directory run-directory config-file)
|
||||
(let* ((nginx-binary #~(string-append #$nginx "/sbin/nginx"))
|
||||
|
|
@ -90,7 +90,7 @@ (define nginx-dmd-service
|
|||
(system* #$nginx-binary "-c" #$config-file #$@args))))))
|
||||
|
||||
;; TODO: Add 'reload' action.
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(provision '(nginx))
|
||||
(documentation "Run the nginx daemon.")
|
||||
(requirement '(user-processes loopback))
|
||||
|
|
@ -100,8 +100,8 @@ (define nginx-dmd-service
|
|||
(define nginx-service-type
|
||||
(service-type (name 'nginx)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
nginx-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
nginx-shepherd-service)
|
||||
(service-extension activation-service-type
|
||||
nginx-activation)
|
||||
(service-extension account-service-type
|
||||
|
|
|
|||
|
|
@ -250,7 +250,7 @@ (define (slim-pam-service config)
|
|||
#:allow-empty-passwords?
|
||||
(slim-configuration-allow-empty-passwords? config))))
|
||||
|
||||
(define (slim-dmd-service config)
|
||||
(define (slim-shepherd-service config)
|
||||
(define slim.cfg
|
||||
(let ((xinitrc (xinitrc #:fallback-session
|
||||
(slim-configuration-auto-login-session config)))
|
||||
|
|
@ -285,7 +285,7 @@ (define slim.cfg
|
|||
(define theme
|
||||
(slim-configuration-theme config))
|
||||
|
||||
(list (dmd-service
|
||||
(list (shepherd-service
|
||||
(documentation "Xorg display server")
|
||||
(provision '(xorg-server))
|
||||
(requirement '(user-processes host-name udev))
|
||||
|
|
@ -308,8 +308,8 @@ (define theme
|
|||
(define slim-service-type
|
||||
(service-type (name 'slim)
|
||||
(extensions
|
||||
(list (service-extension dmd-root-service-type
|
||||
slim-dmd-service)
|
||||
(list (service-extension shepherd-root-service-type
|
||||
slim-shepherd-service)
|
||||
(service-extension pam-root-service-type
|
||||
slim-pam-service)
|
||||
|
||||
|
|
|
|||
|
|
@ -303,11 +303,11 @@ (define known-fs
|
|||
(cons* (service system-service-type entries)
|
||||
%boot-service
|
||||
|
||||
;; %DMD-ROOT-SERVICE must come first so that the gexp that execs
|
||||
;; dmd comes last in the boot script (XXX). Likewise, the cleanup
|
||||
;; service must come last so that its gexp runs before activation
|
||||
;; code.
|
||||
%dmd-root-service
|
||||
;; %SHEPHERD-ROOT-SERVICE must come first so that the gexp that
|
||||
;; execs shepherd comes last in the boot script (XXX). Likewise,
|
||||
;; the cleanup service must come last so that its gexp runs before
|
||||
;; activation code.
|
||||
%shepherd-root-service
|
||||
%activation-service
|
||||
(service cleanup-service-type #f)
|
||||
|
||||
|
|
|
|||
|
|
@ -164,10 +164,10 @@ (define (set-store-permissions directory)
|
|||
(rmdir "/.rw-store"))))))
|
||||
|
||||
(define cow-store-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'cow-store
|
||||
(lambda _
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(requirement '(root-file-system user-processes))
|
||||
(provision '(cow-store))
|
||||
(documentation
|
||||
|
|
|
|||
|
|
@ -313,17 +313,17 @@ (define (service-node-type services)
|
|||
(edges (lift1 (service-back-edges services) %store-monad))))
|
||||
|
||||
(define (dmd-service-node-label service)
|
||||
"Return a label for a node representing a <dmd-service>."
|
||||
(string-join (map symbol->string (dmd-service-provision service))))
|
||||
"Return a label for a node representing a <shepherd-service>."
|
||||
(string-join (map symbol->string (shepherd-service-provision service))))
|
||||
|
||||
(define (dmd-service-node-type services)
|
||||
"Return a node type for SERVICES, a list of <dmd-service>."
|
||||
"Return a node type for SERVICES, a list of <shepherd-service>."
|
||||
(node-type
|
||||
(name "dmd-service")
|
||||
(description "the dependency graph of dmd services")
|
||||
(identifier (lift1 dmd-service-node-label %store-monad))
|
||||
(label dmd-service-node-label)
|
||||
(edges (lift1 (dmd-service-back-edges services) %store-monad))))
|
||||
(edges (lift1 (shepherd-service-back-edges services) %store-monad))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -475,14 +475,14 @@ (define (export-extension-graph os port)
|
|||
#:reverse-edges? #t)))
|
||||
|
||||
(define (export-dmd-graph os port)
|
||||
"Export the graph of dmd services of OS to PORT."
|
||||
(let* ((services (operating-system-services os))
|
||||
(pid1 (fold-services services
|
||||
#:target-type dmd-root-service-type))
|
||||
(dmds (service-parameters pid1)) ;the list of <dmd-service>
|
||||
(sinks (filter (lambda (service)
|
||||
(null? (dmd-service-requirement service)))
|
||||
dmds)))
|
||||
"Export the graph of shepherd services of OS to PORT."
|
||||
(let* ((services (operating-system-services os))
|
||||
(pid1 (fold-services services
|
||||
#:target-type shepherd-root-service-type))
|
||||
(shepherds (service-parameters pid1)) ;list of <shepherd-service>
|
||||
(sinks (filter (lambda (service)
|
||||
(null? (shepherd-service-requirement service)))
|
||||
shepherds)))
|
||||
(export-graph sinks (current-output-port)
|
||||
#:node-type (dmd-service-node-type dmds)
|
||||
#:reverse-edges? #t)))
|
||||
|
|
|
|||
|
|
@ -121,10 +121,10 @@ cat > "$tmpfile" <<EOF
|
|||
(use-service-modules networking)
|
||||
|
||||
(define buggy-service-type
|
||||
(dmd-service-type
|
||||
(shepherd-service-type
|
||||
'buggy
|
||||
(lambda _
|
||||
(dmd-service
|
||||
(shepherd-service
|
||||
(provision '(buggy!))
|
||||
(requirement '(does-not-exist))
|
||||
(start #t)))))
|
||||
|
|
|
|||
|
|
@ -105,11 +105,15 @@ (define-module (test-services)
|
|||
(fold-services (list s) #:target-type t1)
|
||||
#f)))
|
||||
|
||||
(test-assert "dmd-service-back-edges"
|
||||
(let* ((s1 (dmd-service (provision '(s1)) (start #f)))
|
||||
(s2 (dmd-service (provision '(s2)) (requirement '(s1)) (start #f)))
|
||||
(s3 (dmd-service (provision '(s3)) (requirement '(s1 s2)) (start #f)))
|
||||
(e (dmd-service-back-edges (list s1 s2 s3))))
|
||||
(test-assert "shepherd-service-back-edges"
|
||||
(let* ((s1 (shepherd-service (provision '(s1)) (start #f)))
|
||||
(s2 (shepherd-service (provision '(s2))
|
||||
(requirement '(s1))
|
||||
(start #f)))
|
||||
(s3 (shepherd-service (provision '(s3))
|
||||
(requirement '(s1 s2))
|
||||
(start #f)))
|
||||
(e (shepherd-service-back-edges (list s1 s2 s3))))
|
||||
(and (lset= eq? (e s1) (list s2 s3))
|
||||
(lset= eq? (e s2) (list s3))
|
||||
(null? (e s3)))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue