diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/avahi.scm | 10 | ||||
| -rw-r--r-- | gnu/services/base.scm | 126 | ||||
| -rw-r--r-- | gnu/services/databases.scm | 8 | ||||
| -rw-r--r-- | gnu/services/dbus.scm | 8 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 20 | ||||
| -rw-r--r-- | gnu/services/lirc.scm | 8 | ||||
| -rw-r--r-- | gnu/services/mail.scm | 10 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 54 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 149 | ||||
| -rw-r--r-- | gnu/services/ssh.scm | 10 | ||||
| -rw-r--r-- | gnu/services/web.scm | 8 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 8 |
12 files changed, 211 insertions, 208 deletions
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index d458042365..8005b066ed 100644 --- a/gnu/services/avahi.scm +++ b/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 diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 10df9270d9..dcd9956987 100644 --- a/gnu/services/base.scm +++ b/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"))) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index c85606e62d..8b1420116d 100644 --- a/gnu/services/databases.scm +++ b/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 diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 3e5fa14a38..88a840a4b5 100644 --- a/gnu/services/dbus.scm +++ b/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 diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index e6d323270e..9d6abc3867 100644 --- a/gnu/services/desktop.scm +++ b/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 diff --git a/gnu/services/lirc.scm b/gnu/services/lirc.scm index bfaca9b853..069084abf6 100644 --- a/gnu/services/lirc.scm +++ b/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)))))) diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index 181693aeba..4bd1b96b56 100644 --- a/gnu/services/mail.scm +++ b/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 diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index bce1778b5b..5a0a211236 100644 --- a/gnu/services/networking.scm +++ b/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)) diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index ccb71f35e1..36ed9eb1c0 100644 --- a/gnu/services/shepherd.scm +++ b/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)) diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index d6365023ce..33e1951a6e 100644 --- a/gnu/services/ssh.scm +++ b/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 diff --git a/gnu/services/web.scm b/gnu/services/web.scm index bc0aa62a35..0e17f6e5c6 100644 --- a/gnu/services/web.scm +++ b/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 diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index fbe6fad463..a93dbfe7c4 100644 --- a/gnu/services/xorg.scm +++ b/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) |