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 This is the service type that extensions target when they want to create
shepherd services (@pxref{Service Types and Services}, for an example). 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 @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 @defvr {Scheme Variable} %shepherd-root-service
This service represents PID@tie{}1. This service represents PID@tie{}1.
@end defvr @end defvr

View file

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

View file

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

View file

@ -915,7 +915,8 @@ (define* (export-shepherd-graph os port
(let* ((services (operating-system-services os)) (let* ((services (operating-system-services os))
(pid1 (fold-services services (pid1 (fold-services services
#:target-type shepherd-root-service-type)) #: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) (sinks (filter (lambda (service)
(null? (shepherd-service-requirement service))) (null? (shepherd-service-requirement service)))
shepherds))) shepherds)))