Browse Source

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.
wip-mediagoblin
Alex Kost 6 years ago
parent
commit
d4053c710b
  1. 32
      doc/guix.texi
  2. 14
      doc/images/service-graph.dot
  3. 6
      gnu/services.scm
  4. 10
      gnu/services/avahi.scm
  5. 126
      gnu/services/base.scm
  6. 8
      gnu/services/databases.scm
  7. 8
      gnu/services/dbus.scm
  8. 20
      gnu/services/desktop.scm
  9. 8
      gnu/services/lirc.scm
  10. 10
      gnu/services/mail.scm
  11. 54
      gnu/services/networking.scm
  12. 149
      gnu/services/shepherd.scm
  13. 10
      gnu/services/ssh.scm
  14. 8
      gnu/services/web.scm
  15. 8
      gnu/services/xorg.scm
  16. 10
      gnu/system.scm
  17. 4
      gnu/system/install.scm
  18. 24
      guix/scripts/system.scm
  19. 4
      tests/guix-system.sh
  20. 14
      tests/services.scm

32
doc/guix.texi

@ -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

14
doc/images/service-graph.dot

@ -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;

6
gnu/services.scm

@ -86,8 +86,8 @@
;;; 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 @@ containing the given entries."
(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)

10
gnu/services/avahi.scm

@ -93,11 +93,11 @@
(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 @@
(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

126
gnu/services/base.scm

@ -148,8 +148,8 @@
(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 @@
(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 @@ 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 @@ 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 @@ object."
(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 @@ in KNOWN-MOUNT-POINTS when it is stopped."
"/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 @@ that the root file system can be re-mounted read-only, just before
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 @@ strings or string-valued gexps."
;;;
(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 @@ strings or string-valued gexps."
(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 @@ strings or string-valued gexps."
(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 @@ strings or string-valued gexps."
#: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 @@ strings or string-valued gexps."
(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 @@ the tty to run, among other things."
(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 @@ the tty to run, among other things."
(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 @@ Service Switch}, for an example."
(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 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(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 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(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 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(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 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(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 @@ item of @var{packages}."
(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 @@ item of @var{packages}."
"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 @@ item of @var{packages}."
(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 @@ extra rules from the packages listed in @var{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 @@ gexp, to open it, and evaluate @var{close} to close it."
(list target open close)))
(define swap-service-type
(dmd-service-type
(shepherd-service-type
'swap
(lambda (device)
(define requirement
@ -1201,7 +1201,7 @@ gexp, to open it, and evaluate @var{close} to close it."
(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 @@ gexp, to open it, and evaluate @var{close} to close it."
(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 @@ gexp, to open it, and evaluate @var{close} to close it."
(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")))

8
gnu/services/databases.scm

@ -96,7 +96,7 @@ host all all ::1/128 trust"))
(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 @@ host all all ::1/128 trust"))
(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 @@ host all all ::1/128 trust"))
(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

8
gnu/services/dbus.scm

@ -159,10 +159,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(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 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
(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

20
gnu/services/desktop.scm

@ -165,11 +165,11 @@ is set to @var{value} when the bus daemon launches it."
"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 @@ is set to @var{value} when the bus daemon launches it."
(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 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
("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 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
(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

8
gnu/services/lirc.scm

@ -48,10 +48,10 @@
(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-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))))))

10
gnu/services/mail.scm

@ -1574,8 +1574,8 @@ greyed out, instead of only later giving \"not selectable\" popup error.
#: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 @@ greyed out, instead of only later giving \"not selectable\" popup error.
(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 @@ greyed out, instead of only later giving \"not selectable\" popup error.
(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

54
gnu/services/networking.scm

@ -98,7 +98,7 @@ fe80::1%lo0 apps.facebook.com\n")
(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 @@ fe80::1%lo0 apps.facebook.com\n")
;; 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 @@ gateway."
(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 @@ gateway."
(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 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
(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 @@ restrict -6 ::1\n"))
(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 @@ restrict -6 ::1\n"))
(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 @@ HiddenServicePort ~a ~a~%"
#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 @@ HiddenServicePort ~a ~a~%"
(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 @@ project's documentation} for more information."
(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 @@ project's documentation} for more information."
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 @@ project's documentation} for more information."
(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 @@ configuration file."
(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 @@ configuration file."
(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 @@ and @command{wicd-curses} user interfaces."
(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 @@ and @command{wicd-curses} user interfaces."
(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))

149
gnu/services/shepherd.scm

@ -32,26 +32,26 @@
#: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
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
#:export (shepherd-root-service-type
%shepherd-root-service
shepherd-service-type
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 @@
;;; 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 @@
(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 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else."
(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 @@ failure."
(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 @@ failure."
(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 @@ stored."
(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 @@ the list of <dmd-service> that depend on it."
(vhash-consq (provision->service requirement) service
edges))
edges
(dmd-service-requirement service)))
(shepherd-service-requirement service)))
vlist-null
services))

10
gnu/services/ssh.scm

@ -103,8 +103,8 @@
(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 @@
'(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-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

8
gnu/services/web.scm

@ -79,7 +79,7 @@
(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 @@
(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-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

8
gnu/services/xorg.scm

@ -250,7 +250,7 @@ which should be passed to this script as the first argument. If not, the
#: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 @@ reboot_cmd " shepherd "/sbin/reboot\n"
(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 @@ reboot_cmd " shepherd "/sbin/reboot\n"
(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)

10
gnu/system.scm

@ -303,11 +303,11 @@ a container or that of a \"bare metal\" system."
(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)

4
gnu/system/install.scm

@ -164,10 +164,10 @@ current store is on a RAM disk."
(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

24
guix/scripts/system.scm

@ -313,17 +313,17 @@ list of 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 @@ building anything."
#: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)))

4
tests/guix-system.sh

@ -121,10 +121,10 @@ cat > "$tmpfile" <<EOF
(use-service-modules networking)
(define buggy-service-type
(dmd-service-type
(shepherd-service-type
'buggy