services: shepherd: Allow custom 'shepherd' package.

* gnu/services/shepherd.scm (<shepherd-configuration>): New record.
(shepherd-boot-gexp, shepherd-root-service-type): Use it.
(scm->go, shepherd-configuration-file): Allow passing custom
shepherd package.
* gnu/system.scm (operating-system-shepherd-service-names): Use the new
record.
* guix/scripts/system.scm (export-shepherd-graph): Adjust accordingly.
* doc/guix.texi (Shepherd Services). Document it.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Maxime Devos 2021-01-22 20:06:55 +01:00 committed by Ludovic Courtès
parent dae521a0c9
commit 95f72dcd7a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 64 additions and 19 deletions

View File

@ -32782,9 +32782,24 @@ 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{<shepherd-service>}.
Each extension must pass a list of @code{<shepherd-service>}. Its
value must be a @code{shepherd-configuration}, as described below.
@end defvr
@deftp {Data Type} shepherd-configuration
This data type represents the Shepherd's configuration.
@table @code
@item shepherd (default: @code{shepherd})
The Shepherd package to use.
@item services (default: @code{'()})
A list of @code{<shepherd-service>} to start.
You should probably use the service extension
mechanism instead (@pxref{Shepherd Services}).
@end table
@end deftp
@defvr {Scheme Variable} %shepherd-root-service
This service represents PID@tie{}1.
@end defvr

View File

@ -3,6 +3,7 @@
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -36,7 +37,12 @@
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (shepherd-root-service-type
#:export (shepherd-configuration
shepherd-configuration?
shepherd-configuration-shepherd
shepherd-configuration-services
shepherd-root-service-type
%shepherd-root-service
shepherd-service-type
@ -76,7 +82,18 @@
;;; Code:
(define (shepherd-boot-gexp services)
(define-record-type* <shepherd-configuration>
shepherd-configuration make-shepherd-configuration
shepherd-configuration?
(shepherd shepherd-configuration-shepherd
(default shepherd)) ; package
(services shepherd-configuration-services
(default '()))) ; list of <shepherd-service>
(define (shepherd-boot-gexp config)
"Return a gexp starting the shepherd service."
(let ((shepherd (shepherd-configuration-shepherd config))
(services (shepherd-configuration-services config)))
#~(begin
;; Keep track of the booted system.
(false-if-exception (delete-file "/run/booted-system"))
@ -95,7 +112,10 @@
;; Start shepherd.
(execl #$(file-append shepherd "/bin/shepherd")
"shepherd" "--config"
#$(shepherd-configuration-file services))))
#$(shepherd-configuration-file services shepherd)))))
(define shepherd-packages
(compose list shepherd-configuration-shepherd))
(define shepherd-root-service-type
(service-type
@ -103,20 +123,25 @@
;; Extending the root shepherd service (aka. PID 1) happens by
;; concatenating the list of services provided by the extensions.
(compose concatenate)
(extend append)
(extend (lambda (config extra-services)
(shepherd-configuration
(inherit config)
(services (append (shepherd-configuration-services config)
extra-services)))))
(extensions (list (service-extension boot-service-type
shepherd-boot-gexp)
(service-extension profile-service-type
(const (list shepherd)))))
shepherd-packages)))
(default-value (shepherd-configuration))
(description
"Run the GNU Shepherd as PID 1---i.e., the operating system's first
process. The Shepherd takes care of managing services such as daemons by
ensuring they are started and stopped in the right order.")))
(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 '()))
;; The root shepherd service, aka. PID 1. Its parameter is a
;; <shepherd-configuration>.
(service shepherd-root-service-type))
(define-syntax shepherd-service-type
(syntax-rules (description)
@ -270,9 +295,9 @@ stored."
#~(#$name #$doc #$proc)))
(shepherd-service-actions service))))))))
(define (scm->go file)
(define (scm->go file shepherd)
"Compile FILE, which contains code to be loaded by shepherd's config file,
and return the resulting '.go' file."
and return the resulting '.go' file. SHEPHERD is used as shepherd package."
(let-system (system target)
(with-extensions (list shepherd)
(computed-file (string-append (basename (scheme-file-name file) ".scm")
@ -294,11 +319,13 @@ and return the resulting '.go' file."
#:options '(#:local-build? #t
#:substitutable? #f)))))
(define (shepherd-configuration-file services)
"Return the shepherd configuration file for SERVICES."
(define (shepherd-configuration-file services shepherd)
"Return the shepherd configuration file for SERVICES. SHEPHERD is used
as shepherd package."
(assert-valid-graph services)
(let ((files (map shepherd-service-file services)))
(let ((files (map shepherd-service-file services))
(scm->go (cute scm->go <> shepherd)))
(define config
#~(begin
(use-modules (srfi srfi-34)

View File

@ -12,6 +12,7 @@
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek@gnu.org>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -1134,10 +1135,11 @@ we're running in the final root."
(define (operating-system-shepherd-service-names os)
"Return the list of Shepherd service names for OS."
(append-map shepherd-service-provision
(service-value
(fold-services (operating-system-services os)
#:target-type
shepherd-root-service-type))))
(shepherd-configuration-services
(service-value
(fold-services (operating-system-services os)
#:target-type
shepherd-root-service-type)))))
(define* (operating-system-derivation os)
"Return a derivation that builds OS."

View File

@ -915,7 +915,8 @@ Run 'herd status' to view the list of services on your system.\n"))))))
(let* ((services (operating-system-services os))
(pid1 (fold-services services
#:target-type shepherd-root-service-type))
(shepherds (service-value pid1)) ;list of <shepherd-service>
;; Get the list of <shepherd-service>.
(shepherds (shepherd-configuration-services (service-value pid1)))
(sinks (filter (lambda (service)
(null? (shepherd-service-requirement service)))
shepherds)))