From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Kost Subject: [PATCH 06/11] Rename (gnu services dmd) to (gnu services shepherd). Date: Thu, 28 Jan 2016 00:10:31 +0300 Message-ID: <1453929036-10408-7-git-send-email-alezost@gmail.com> References: <1453929036-10408-1-git-send-email-alezost@gmail.com> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:46027) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aOXMn-0008Iw-6e for guix-devel@gnu.org; Wed, 27 Jan 2016 16:11:09 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aOXMh-0006a6-Nm for guix-devel@gnu.org; Wed, 27 Jan 2016 16:11:05 -0500 Received: from mail-lb0-x242.google.com ([2a00:1450:4010:c04::242]:36497) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aOXMh-0006YY-50 for guix-devel@gnu.org; Wed, 27 Jan 2016 16:10:59 -0500 Received: by mail-lb0-x242.google.com with SMTP id ad5so896809lbc.3 for ; Wed, 27 Jan 2016 13:10:59 -0800 (PST) Received: from localhost.localdomain ([217.107.192.146]) by smtp.gmail.com with ESMTPSA id p66sm1045517lfe.42.2016.01.27.13.10.57 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-SHA bits=128/128); Wed, 27 Jan 2016 13:10:57 -0800 (PST) In-Reply-To: <1453929036-10408-1-git-send-email-alezost@gmail.com> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org * gnu/services/dmd.scm: Rename to... * gnu/services/shepherd.scm: ... this. * gnu/system.scm: Use it. * gnu/system/install.scm: Likewise. * gnu/services/xorg.scm: Likewise. * gnu/services/web.scm: Likewise. * gnu/services/ssh.scm: Likewise. * gnu/services/networking.scm: Likewise. * gnu/services/mail.scm: Likewise. * gnu/services/lirc.scm: Likewise. * gnu/services/desktop.scm: Likewise. * gnu/services/dbus.scm: Likewise. * gnu/services/databases.scm: Likewise. * gnu/services/base.scm: Likewise. * gnu/services/avahi.scm: Likewise. * guix/scripts/system.scm: Likewise. * tests/services.scm: Likewise. * tests/guix-system.sh: Likewise. * doc/guix.texi (Shepherd Services): Adjust accordingly. * gnu-system.am (GNU_SYSTEM_MODULES): Likewise. * po/guix/POTFILES.in: Likewise. --- doc/guix.texi | 8 +- gnu-system.am | 2 +- gnu/services/avahi.scm | 2 +- gnu/services/base.scm | 2 +- gnu/services/databases.scm | 2 +- gnu/services/dbus.scm | 2 +- gnu/services/desktop.scm | 2 +- gnu/services/dmd.scm | 275 -------------------------------------------- gnu/services/lirc.scm | 2 +- gnu/services/mail.scm | 2 +- gnu/services/networking.scm | 2 +- gnu/services/shepherd.scm | 275 ++++++++++++++++++++++++++++++++++++++++++++ gnu/services/ssh.scm | 2 +- gnu/services/web.scm | 2 +- gnu/services/xorg.scm | 2 +- gnu/system.scm | 2 +- gnu/system/install.scm | 2 +- guix/scripts/system.scm | 2 +- po/guix/POTFILES.in | 2 +- tests/guix-system.sh | 4 +- tests/services.scm | 2 +- 21 files changed, 298 insertions(+), 298 deletions(-) delete mode 100644 gnu/services/dmd.scm create mode 100644 gnu/services/shepherd.scm diff --git a/doc/guix.texi b/doc/guix.texi index 55e2c67..6c6d170 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9764,10 +9764,10 @@ extend it by passing it lists of packages to add to the system profile. @cindex PID 1 @cindex init system -The @code{(gnu services dmd)} provides a way to define services managed -by GNU@tie{}Shepherd, which is GuixSD initialization system---the first -process that is started when the system boots, aka. PID@tie{}1 -(@pxref{Introduction,,, shepherd, GNU Shepherd Manual}). +The @code{(gnu services shepherd)} provides a way to define services +managed by GNU@tie{}Shepherd, which is GuixSD initialization +system---the first process that is started when the system boots, +aka. PID@tie{}1 (@pxref{Introduction,,, shepherd, GNU Shepherd Manual}). Services in Shepherd can depend on each other. For instance, the SSH daemon may need to be started after the syslog daemon has been started, diff --git a/gnu-system.am b/gnu-system.am index ad59241..75ab91f 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -361,10 +361,10 @@ GNU_SYSTEM_MODULES = \ gnu/services/databases.scm \ gnu/services/dbus.scm \ gnu/services/desktop.scm \ - gnu/services/dmd.scm \ gnu/services/lirc.scm \ gnu/services/mail.scm \ gnu/services/networking.scm \ + gnu/services/shepherd.scm \ gnu/services/ssh.scm \ gnu/services/web.scm \ gnu/services/xorg.scm \ diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 909abef..d458042 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -19,7 +19,7 @@ (define-module (gnu services avahi) #:use-module (gnu services) #:use-module (gnu services base) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu services dbus) #:use-module (gnu system shadow) #:use-module (gnu packages avahi) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 6483a66..10df927 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -22,7 +22,7 @@ (define-module (gnu services base) #:use-module (guix store) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu services networking) #:use-module (gnu system pam) #:use-module (gnu system shadow) ; 'user-account', etc. diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 8fdd222..c85606e 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -19,7 +19,7 @@ (define-module (gnu services databases) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages databases) diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 9b0d198..3e5fa14 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -19,7 +19,7 @@ (define-module (gnu services dbus) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module ((gnu packages glib) #:select (dbus/activation)) #:use-module (gnu packages admin) diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 694a8ed..e6d3232 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -20,7 +20,7 @@ (define-module (gnu services desktop) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu services base) #:use-module (gnu services dbus) #:use-module (gnu services avahi) diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm deleted file mode 100644 index 828d781..0000000 --- a/gnu/services/dmd.scm +++ /dev/null @@ -1,275 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (gnu services dmd) - #:use-module (guix ui) - #:use-module (guix sets) - #:use-module (guix gexp) - #:use-module (guix store) - #:use-module (guix monads) - #:use-module (guix records) - #:use-module (guix derivations) ;imported-modules, etc. - #:use-module (gnu services) - #:use-module (gnu packages admin) - #:use-module (ice-9 match) - #:use-module (ice-9 vlist) - #:use-module (srfi srfi-1) - #: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 - - %default-imported-modules - %default-modules - - dmd-service-back-edges)) - -;;; Commentary: -;;; -;;; Instantiating system services as a dmd configuration file. -;;; -;;; Code: - - -(define (dmd-boot-gexp services) - (mlet %store-monad ((dmd-conf (dmd-configuration-file services))) - (return #~(begin - ;; Keep track of the booted system. - (false-if-exception (delete-file "/run/booted-system")) - (symlink (readlink "/run/current-system") - "/run/booted-system") - - ;; Close any remaining open file descriptors to be on the safe - ;; side. This must be the very last thing we do, because - ;; Guile has internal FDs such as 'sleep_pipe' that need to be - ;; alive. - (let loop ((fd 3)) - (when (< fd 1024) - (false-if-exception (close-fdes fd)) - (loop (+ 1 fd)))) - - ;; Start shepherd. - (execl (string-append #$shepherd "/bin/shepherd") - "shepherd" "--config" #$dmd-conf))))) - -(define dmd-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. - (compose concatenate) - (extend append) - (extensions (list (service-extension boot-service-type dmd-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 - ;; objects. - (service dmd-root-service-type '())) - -(define-syntax-rule (dmd-service-type service-name proc) - "Return a denoting a simple dmd service--i.e., the type for a -service that extends DMD-ROOT-SERVICE-TYPE and nothing else." - (service-type - (name service-name) - (extensions - (list (service-extension dmd-root-service-type - (compose list proc)))))) - -(define %default-imported-modules - ;; Default set of modules imported for a service's consumption. - '((guix build utils) - (guix build syscalls))) - -(define %default-modules - ;; Default set of modules visible in a service's file. - `((shepherd service) - (oop goops) - (guix build utils) - (guix build syscalls))) - -(define-record-type* - dmd-service make-dmd-service - dmd-service? - (documentation dmd-service-documentation ;string - (default "[No documentation.]")) - (provision dmd-service-provision) ;list of symbols - (requirement dmd-service-requirement ;list of symbols - (default '())) - (respawn? dmd-service-respawn? ;Boolean - (default #t)) - (start dmd-service-start) ;g-expression (procedure) - (stop dmd-service-stop ;g-expression (procedure) - (default #~(const #f))) - (auto-start? dmd-service-auto-start? ;Boolean - (default #t)) - (modules dmd-service-modules ;list of module names - (default %default-modules)) - (imported-modules dmd-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 -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." - (define provisions - ;; The set of provisions (symbols). Bail out if a symbol is given more - ;; than once. - (fold (lambda (service set) - (define (assert-unique symbol) - (when (set-contains? set symbol) - (raise (condition - (&message - (message - (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) - services)) - - (define (assert-satisfied-requirements service) - ;; Bail out if the requirements of SERVICE aren't satisfied. - (for-each (lambda (requirement) - (unless (set-contains? provisions requirement) - (raise (condition - (&message - (message - (format #f (_ "service '~a' requires '~a', \ -which is undefined") - (match (dmd-service-provision service) - ((head . _) head) - (_ service)) - requirement))))))) - (dmd-service-requirement service))) - - (for-each assert-satisfied-requirements services)) - -(define (dmd-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-" - (string-map (match-lambda - (#\/ #\-) - (chr chr)) - provisions) - ".scm"))) - -(define (dmd-service-file service) - "Return a file defining SERVICE." - (gexp->file (dmd-service-file-name service) - #~(begin - (use-modules #$@(dmd-service-modules service)) - - (make - #: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))))) - -(define (dmd-configuration-file services) - "Return the dmd configuration file for SERVICES." - (define modules - (delete-duplicates - (append-map dmd-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))) - (define config - #~(begin - (eval-when (expand load eval) - (set! %load-path (cons #$modules %load-path)) - (set! %load-compiled-path - (cons #$compiled %load-compiled-path))) - - (use-modules (system repl error-handling)) - - ;; Arrange to spawn a REPL if loading one of FILES fails. This is - ;; better than a kernel panic. - (call-with-error-handling - (lambda () - (apply register-services (map primitive-load '#$files)))) - - ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it. - (setenv "PATH" "/run/current-system/profile/bin") - - (format #t "starting services...~%") - (for-each start - '#$(append-map dmd-service-provision - (filter dmd-service-auto-start? - services))))) - - (gexp->file "dmd.conf" config))) - -(define (dmd-service-back-edges services) - "Return a procedure that, when given a from SERVICES, returns -the list of that depend on it." - (define provision->service - (let ((services (fold (lambda (service result) - (fold (cut vhash-consq <> service <>) - result - (dmd-service-provision service))) - vlist-null - services))) - (lambda (name) - (match (vhash-assq name services) - ((_ . service) service) - (#f #f))))) - - (define edges - (fold (lambda (service edges) - (fold (lambda (requirement edges) - (vhash-consq (provision->service requirement) service - edges)) - edges - (dmd-service-requirement service))) - vlist-null - services)) - - (lambda (service) - (vhash-foldq* cons '() service edges))) - -;;; dmd.scm ends here diff --git a/gnu/services/lirc.scm b/gnu/services/lirc.scm index 6ae6225..bfaca9b 100644 --- a/gnu/services/lirc.scm +++ b/gnu/services/lirc.scm @@ -19,7 +19,7 @@ (define-module (gnu services lirc) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu packages lirc) #:use-module (guix gexp) #:use-module (guix records) diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index f49a4a4..181693a 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -21,7 +21,7 @@ (define-module (gnu services mail) #:use-module (gnu services) #:use-module (gnu services base) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu system pam) #:use-module (gnu system shadow) #:use-module (gnu packages mail) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index ce21b1d..bce1778 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -19,7 +19,7 @@ (define-module (gnu services networking) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu services dbus) #:use-module (gnu system shadow) #:use-module (gnu system pam) diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm new file mode 100644 index 0000000..a33985e --- /dev/null +++ b/gnu/services/shepherd.scm @@ -0,0 +1,275 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services shepherd) + #:use-module (guix ui) + #:use-module (guix sets) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix records) + #:use-module (guix derivations) ;imported-modules, etc. + #:use-module (gnu services) + #:use-module (gnu packages admin) + #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #: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 + + %default-imported-modules + %default-modules + + dmd-service-back-edges)) + +;;; Commentary: +;;; +;;; Instantiating system services as a dmd configuration file. +;;; +;;; Code: + + +(define (dmd-boot-gexp services) + (mlet %store-monad ((dmd-conf (dmd-configuration-file services))) + (return #~(begin + ;; Keep track of the booted system. + (false-if-exception (delete-file "/run/booted-system")) + (symlink (readlink "/run/current-system") + "/run/booted-system") + + ;; Close any remaining open file descriptors to be on the safe + ;; side. This must be the very last thing we do, because + ;; Guile has internal FDs such as 'sleep_pipe' that need to be + ;; alive. + (let loop ((fd 3)) + (when (< fd 1024) + (false-if-exception (close-fdes fd)) + (loop (+ 1 fd)))) + + ;; Start shepherd. + (execl (string-append #$shepherd "/bin/shepherd") + "shepherd" "--config" #$dmd-conf))))) + +(define dmd-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. + (compose concatenate) + (extend append) + (extensions (list (service-extension boot-service-type dmd-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 + ;; objects. + (service dmd-root-service-type '())) + +(define-syntax-rule (dmd-service-type service-name proc) + "Return a denoting a simple dmd service--i.e., the type for a +service that extends DMD-ROOT-SERVICE-TYPE and nothing else." + (service-type + (name service-name) + (extensions + (list (service-extension dmd-root-service-type + (compose list proc)))))) + +(define %default-imported-modules + ;; Default set of modules imported for a service's consumption. + '((guix build utils) + (guix build syscalls))) + +(define %default-modules + ;; Default set of modules visible in a service's file. + `((shepherd service) + (oop goops) + (guix build utils) + (guix build syscalls))) + +(define-record-type* + dmd-service make-dmd-service + dmd-service? + (documentation dmd-service-documentation ;string + (default "[No documentation.]")) + (provision dmd-service-provision) ;list of symbols + (requirement dmd-service-requirement ;list of symbols + (default '())) + (respawn? dmd-service-respawn? ;Boolean + (default #t)) + (start dmd-service-start) ;g-expression (procedure) + (stop dmd-service-stop ;g-expression (procedure) + (default #~(const #f))) + (auto-start? dmd-service-auto-start? ;Boolean + (default #t)) + (modules dmd-service-modules ;list of module names + (default %default-modules)) + (imported-modules dmd-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 +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." + (define provisions + ;; The set of provisions (symbols). Bail out if a symbol is given more + ;; than once. + (fold (lambda (service set) + (define (assert-unique symbol) + (when (set-contains? set symbol) + (raise (condition + (&message + (message + (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) + services)) + + (define (assert-satisfied-requirements service) + ;; Bail out if the requirements of SERVICE aren't satisfied. + (for-each (lambda (requirement) + (unless (set-contains? provisions requirement) + (raise (condition + (&message + (message + (format #f (_ "service '~a' requires '~a', \ +which is undefined") + (match (dmd-service-provision service) + ((head . _) head) + (_ service)) + requirement))))))) + (dmd-service-requirement service))) + + (for-each assert-satisfied-requirements services)) + +(define (dmd-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-" + (string-map (match-lambda + (#\/ #\-) + (chr chr)) + provisions) + ".scm"))) + +(define (dmd-service-file service) + "Return a file defining SERVICE." + (gexp->file (dmd-service-file-name service) + #~(begin + (use-modules #$@(dmd-service-modules service)) + + (make + #: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))))) + +(define (dmd-configuration-file services) + "Return the dmd configuration file for SERVICES." + (define modules + (delete-duplicates + (append-map dmd-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))) + (define config + #~(begin + (eval-when (expand load eval) + (set! %load-path (cons #$modules %load-path)) + (set! %load-compiled-path + (cons #$compiled %load-compiled-path))) + + (use-modules (system repl error-handling)) + + ;; Arrange to spawn a REPL if loading one of FILES fails. This is + ;; better than a kernel panic. + (call-with-error-handling + (lambda () + (apply register-services (map primitive-load '#$files)))) + + ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it. + (setenv "PATH" "/run/current-system/profile/bin") + + (format #t "starting services...~%") + (for-each start + '#$(append-map dmd-service-provision + (filter dmd-service-auto-start? + services))))) + + (gexp->file "dmd.conf" config))) + +(define (dmd-service-back-edges services) + "Return a procedure that, when given a from SERVICES, returns +the list of that depend on it." + (define provision->service + (let ((services (fold (lambda (service result) + (fold (cut vhash-consq <> service <>) + result + (dmd-service-provision service))) + vlist-null + services))) + (lambda (name) + (match (vhash-assq name services) + ((_ . service) service) + (#f #f))))) + + (define edges + (fold (lambda (service edges) + (fold (lambda (requirement edges) + (vhash-consq (provision->service requirement) service + edges)) + edges + (dmd-service-requirement service))) + vlist-null + services)) + + (lambda (service) + (vhash-foldq* cons '() service edges))) + +;;; shepherd.scm ends here diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 4b0380e..d636502 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -20,7 +20,7 @@ #:use-module (guix gexp) #:use-module (guix records) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu system pam) #:use-module (gnu packages lsh) #:use-module (srfi srfi-26) diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 84bb30d..bc0aa62 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -19,7 +19,7 @@ (define-module (gnu services web) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages web) diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 7fea682..4b81bd9 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -20,7 +20,7 @@ (define-module (gnu services xorg) #:use-module (gnu artwork) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu system pam) #:use-module ((gnu packages base) #:select (canonical-package)) #:use-module (gnu packages guile) diff --git a/gnu/system.scm b/gnu/system.scm index 0245184..97103a9 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -44,7 +44,7 @@ #:use-module (gnu packages firmware) #:autoload (gnu packages cryptsetup) (cryptsetup) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu services base) #:use-module (gnu system grub) #:use-module (gnu system shadow) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 887bceb..fcbb630 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -24,7 +24,7 @@ #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) #:use-module (guix profiles) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (gnu packages linux) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 564ed02..3f368ca 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -40,7 +40,7 @@ #:use-module (gnu system vm) #:use-module (gnu system grub) #:use-module (gnu services) - #:use-module (gnu services dmd) + #:use-module (gnu services shepherd) #:use-module (gnu packages grub) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index bf65416..27cc649 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -3,7 +3,7 @@ gnu/packages.scm gnu/services.scm gnu/system.scm -gnu/services/dmd.scm +gnu/services/shepherd.scm gnu/system/shadow.scm guix/scripts.scm guix/scripts/build.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 02e2524..cd135b9 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -114,10 +114,10 @@ else grep "service 'networking'.*more than once" "$errorfile" fi -# Reporting unmet dmd requirements. +# Reporting unmet shepherd requirements. cat > "$tmpfile" <