1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013-2016, 2018-2022 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
4 ;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
5 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
6 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
8 ;;; This file is part of GNU Guix.
10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
11 ;;; under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or (at
13 ;;; your option) any later version.
15 ;;; GNU Guix is distributed in the hope that it will be useful, but
16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
23 (define-module (gnu services shepherd)
24 #:use-module (guix ui)
25 #:use-module (guix sets)
26 #:use-module (guix gexp)
27 #:use-module (guix store)
28 #:use-module (guix records)
29 #:use-module (guix packages)
30 #:use-module (guix derivations) ;imported-modules, etc.
31 #:use-module (guix utils)
32 #:use-module (gnu services)
33 #:use-module (gnu services herd)
34 #:use-module (gnu packages admin)
35 #:use-module (ice-9 match)
36 #:use-module (ice-9 vlist)
37 #:use-module (srfi srfi-1)
38 #:use-module (srfi srfi-26)
39 #:use-module (srfi srfi-34)
40 #:use-module (srfi srfi-35)
41 #:export (shepherd-configuration
42 shepherd-configuration?
43 shepherd-configuration-shepherd
44 shepherd-configuration-services
46 shepherd-root-service-type
47 %shepherd-root-service
52 shepherd-service-documentation
53 shepherd-service-provision
54 shepherd-service-canonical-name
55 shepherd-service-requirement
56 shepherd-service-one-shot?
57 shepherd-service-respawn?
58 shepherd-service-start
60 shepherd-service-auto-start?
61 shepherd-service-modules
66 shepherd-action-documentation
67 shepherd-action-procedure
73 shepherd-service-lookup-procedure
74 shepherd-service-back-edges
75 shepherd-service-upgrade
77 user-processes-service-type
83 ;;; Instantiating system services as a shepherd configuration file.
88 (define-record-type* <shepherd-configuration>
89 shepherd-configuration make-shepherd-configuration
90 shepherd-configuration?
91 (shepherd shepherd-configuration-shepherd
92 (default shepherd-0.9)) ; file-like
93 (services shepherd-configuration-services
94 (default '()))) ; list of <shepherd-service>
96 (define (shepherd-boot-gexp config)
97 "Return a gexp starting the shepherd service."
98 (let ((shepherd (shepherd-configuration-shepherd config))
99 (services (shepherd-configuration-services config)))
101 ;; Keep track of the booted system.
102 (false-if-exception (delete-file "/run/booted-system"))
104 ;; Make /run/booted-system, an indirect GC root, point to the store item
105 ;; /run/current-system points to. Use 'canonicalize-path' rather than
106 ;; 'readlink' to make sure we get the store item.
107 (symlink (canonicalize-path "/run/current-system")
108 "/run/booted-system")
110 ;; Ensure open file descriptors are close-on-exec so shepherd doesn't
115 (let ((flags (fcntl fd F_GETFD)))
116 (when (zero? (logand flags FD_CLOEXEC))
117 (fcntl fd F_SETFD (logior FD_CLOEXEC flags)))))
121 (execl #$(file-append shepherd "/bin/shepherd")
122 "shepherd" "--config"
123 #$(shepherd-configuration-file services shepherd)))))
125 (define shepherd-packages
126 (compose list shepherd-configuration-shepherd))
128 (define shepherd-root-service-type
130 (name 'shepherd-root)
131 ;; Extending the root shepherd service (aka. PID 1) happens by
132 ;; concatenating the list of services provided by the extensions.
133 (compose concatenate)
134 (extend (lambda (config extra-services)
135 (shepherd-configuration
137 (services (append (shepherd-configuration-services config)
139 (extensions (list (service-extension boot-service-type
141 (service-extension profile-service-type
143 (default-value (shepherd-configuration))
145 "Run the GNU Shepherd as PID 1---i.e., the operating system's first
146 process. The Shepherd takes care of managing services such as daemons by
147 ensuring they are started and stopped in the right order.")))
149 (define %shepherd-root-service
150 ;; The root shepherd service, aka. PID 1. Its parameter is a
151 ;; <shepherd-configuration>.
152 (service shepherd-root-service-type))
154 (define-syntax shepherd-service-type
155 (syntax-rules (description)
156 "Return a <service-type> denoting a simple shepherd service--i.e., the type
157 for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else. When
158 DEFAULT is given, use it as the service's default value."
159 ((_ service-name proc default (description text))
163 (list (service-extension shepherd-root-service-type
164 (compose list proc))))
165 (default-value default)
167 ((_ service-name proc (description text))
171 (list (service-extension shepherd-root-service-type
172 (compose list proc))))
173 (description text)))))
175 (define %default-imported-modules
176 ;; Default set of modules imported for a service's consumption.
178 (guix build syscalls)))
180 (define %default-modules
181 ;; Default set of modules visible in a service's file.
184 ((guix build utils) #:hide (delete))
185 (guix build syscalls)))
187 (define-record-type* <shepherd-service>
188 shepherd-service make-shepherd-service
190 (documentation shepherd-service-documentation ;string
191 (default "[No documentation.]"))
192 (provision shepherd-service-provision) ;list of symbols
193 (requirement shepherd-service-requirement ;list of symbols
195 (one-shot? shepherd-service-one-shot? ;Boolean
197 (respawn? shepherd-service-respawn? ;Boolean
199 (start shepherd-service-start) ;g-expression (procedure)
200 (stop shepherd-service-stop ;g-expression (procedure)
201 (default #~(const #f)))
202 (actions shepherd-service-actions ;list of <shepherd-action>
204 (auto-start? shepherd-service-auto-start? ;Boolean
206 (modules shepherd-service-modules ;list of module names
207 (default %default-modules)))
209 (define-record-type* <shepherd-action>
210 shepherd-action make-shepherd-action
212 (name shepherd-action-name) ;symbol
213 (procedure shepherd-action-procedure) ;gexp
214 (documentation shepherd-action-documentation)) ;string
216 (define (shepherd-service-canonical-name service)
217 "Return the 'canonical name' of SERVICE."
218 (first (shepherd-service-provision service)))
220 (define (assert-valid-graph services)
221 "Raise an error if SERVICES does not define a valid shepherd service graph,
222 for instance if a service requires a nonexistent service, or if more than one
223 service uses a given name.
225 These are constraints that shepherd's 'register-service' verifies but we'd
226 better verify them here statically than wait until PID 1 halts with an
229 ;; The set of provisions (symbols). Bail out if a symbol is given more
231 (fold (lambda (service set)
232 (define (assert-unique symbol)
233 (when (set-contains? set symbol)
237 (format #f (G_ "service '~a' provided more than once")
240 (for-each assert-unique (shepherd-service-provision service))
241 (fold set-insert set (shepherd-service-provision service)))
245 (define (assert-satisfied-requirements service)
246 ;; Bail out if the requirements of SERVICE aren't satisfied.
247 (for-each (lambda (requirement)
248 (unless (set-contains? provisions requirement)
252 (format #f (G_ "service '~a' requires '~a', \
253 which is not provided by any service")
254 (match (shepherd-service-provision service)
258 (shepherd-service-requirement service)))
260 (for-each assert-satisfied-requirements services))
262 (define %store-characters
263 ;; Valid store characters; see 'checkStoreName' in the daemon.
265 "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
267 (define (shepherd-service-file-name service)
268 "Return the file name where the initialization code for SERVICE is to be
270 (let ((provisions (string-join (map symbol->string
271 (shepherd-service-provision service)))))
272 (string-append "shepherd-"
273 (string-map (lambda (chr)
274 (if (char-set-contains? %store-characters chr)
280 (define (shepherd-service-file service)
281 "Return a file defining SERVICE."
282 (scheme-file (shepherd-service-file-name service)
283 (with-imported-modules %default-imported-modules
285 (use-modules #$@(shepherd-service-modules service))
288 #:docstring '#$(shepherd-service-documentation service)
289 #:provides '#$(shepherd-service-provision service)
290 #:requires '#$(shepherd-service-requirement service)
292 ;; The 'one-shot?' slot is new in Shepherd 0.6.0.
293 ;; Older versions ignore it.
294 #:one-shot? '#$(shepherd-service-one-shot? service)
296 #:respawn? '#$(shepherd-service-respawn? service)
297 #:start #$(shepherd-service-start service)
298 #:stop #$(shepherd-service-stop service)
301 #$@(map (match-lambda
302 (($ <shepherd-action> name proc doc)
303 #~(#$name #$doc #$proc)))
304 (shepherd-service-actions service))))))))
306 (define (scm->go file shepherd)
307 "Compile FILE, which contains code to be loaded by shepherd's config file,
308 and return the resulting '.go' file. SHEPHERD is used as shepherd package."
311 (match (lookup-package-input shepherd "guile-fibers")
313 (fibers (list fibers)))))
315 (let-system (system target)
316 (with-extensions shepherd&co
317 (computed-file (string-append (basename (scheme-file-name file) ".scm")
320 (use-modules (system base compile)
321 (system base target))
323 ;; Do the same as the Shepherd's 'load-in-user-module'.
324 (let ((env (make-fresh-user-module)))
325 (module-use! env (resolve-interface '(oop goops)))
326 (module-use! env (resolve-interface '(shepherd service)))
327 (with-target #$(or target #~%host-type)
329 (compile-file #$file #:output-file #$output
332 ;; It's faster to build locally than to download.
333 #:options '(#:local-build? #t
334 #:substitutable? #f)))))
336 (define (shepherd-configuration-file services shepherd)
337 "Return the shepherd configuration file for SERVICES. SHEPHERD is used
338 as shepherd package."
339 (assert-valid-graph services)
341 (let ((files (map shepherd-service-file services))
342 (scm->go (cute scm->go <> shepherd)))
345 (use-modules (srfi srfi-34)
346 (system repl error-handling))
348 (define (call-with-file file flags proc)
352 (set! port (open file flags)))
359 ;; There's code run from shepherd that uses 'call-with-input-file' &
360 ;; co.--e.g., the 'urandom-seed' service. Starting from Shepherd
361 ;; 0.9.2, users need to make sure not to leak non-close-on-exec file
362 ;; descriptors to child processes. To address that, replace the
363 ;; standard bindings with O_CLOEXEC variants.
364 (set! call-with-input-file
366 (call-with-file file (logior O_RDONLY O_CLOEXEC)
368 (set! call-with-output-file
370 (call-with-file file (logior O_WRONLY O_CREAT O_CLOEXEC)
373 ;; Specify the default environment visible to all the services.
374 ;; Without this statement, all the environment variables of PID 1
375 ;; are inherited by child services.
376 (default-environment-variables
377 '("PATH=/run/current-system/profile/bin"))
379 ;; Booting off a DVD, especially on a slow machine, can make
380 ;; everything slow. Thus, increase the timeout compared to the
381 ;; default 5s in the Shepherd 0.7.0. See
382 ;; <https://bugs.gnu.org/40572>.
383 (default-pid-file-timeout 30)
385 ;; Arrange to spawn a REPL if something goes wrong. This is better
386 ;; than a kernel panic.
387 (call-with-error-handling
389 (apply register-services
390 (parameterize ((current-warning-port
391 (%make-void-port "w")))
392 (map load-compiled '#$(map scm->go files))))))
394 (format #t "starting services...~%")
395 (let ((services-to-start
396 '#$(append-map shepherd-service-provision
397 (filter shepherd-service-auto-start?
399 (if (defined? 'start-in-the-background)
400 (start-in-the-background services-to-start)
401 (for-each (lambda (service) ;pre-0.9.0 compatibility
402 (guard (c ((service-error? c)
403 (format (current-error-port)
404 "failed to start service '~a'~%"
409 ;; Hang up stdin. At this point, we assume that 'start' methods
410 ;; that required user interaction on the console (e.g.,
411 ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have
412 ;; completed. User interaction becomes impossible after this
413 ;; call; this avoids situations where services wrongfully lead
414 ;; PID 1 to read from stdin (the console), which users may not
415 ;; have access to (see <https://bugs.gnu.org/23697>).
416 (redirect-port (open "/dev/null" (logior O_RDONLY O_CLOEXEC))
417 (current-input-port)))))
419 (scheme-file "shepherd.conf" config)))
421 (define* (shepherd-service-lookup-procedure services
424 shepherd-service-provision))
425 "Return a procedure that, when passed a symbol, return the item among
426 SERVICES that provides this symbol. PROVISION must be a one-argument
427 procedure that takes a service and returns the list of symbols it provides."
428 (let ((services (fold (lambda (service result)
429 (fold (cut vhash-consq <> service <>)
431 (provision service)))
435 (match (vhash-assq name services)
436 ((_ . service) service)
439 (define* (shepherd-service-back-edges services
441 (provision shepherd-service-provision)
442 (requirement shepherd-service-requirement))
443 "Return a procedure that, when given a <shepherd-service> from SERVICES,
444 returns the list of <shepherd-service> that depend on it.
446 Use PROVISION and REQUIREMENT as one-argument procedures that return the
447 symbols provided/required by a service."
448 (define provision->service
449 (shepherd-service-lookup-procedure services provision))
452 (fold (lambda (service edges)
453 (fold (lambda (requirement edges)
454 (vhash-consq (provision->service requirement) service
457 (requirement service)))
462 (vhash-foldq* cons '() service edges)))
464 (define (shepherd-service-upgrade live target)
465 "Return two values: the subset of LIVE (a list of <live-service>) that needs
466 to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
467 need to be restarted to complete their upgrade."
468 (define (essential? service)
469 (memq (first (live-service-provision service))
472 (define lookup-target
473 (shepherd-service-lookup-procedure target
474 shepherd-service-provision))
477 (shepherd-service-lookup-procedure live
478 live-service-provision))
480 (define (running? service)
481 (and=> (lookup-live (shepherd-service-canonical-name service))
482 live-service-running))
484 (define live-service-dependents
485 (shepherd-service-back-edges live
486 #:provision live-service-provision
487 #:requirement live-service-requirement))
489 (define (obsolete? service)
490 (match (lookup-target (first (live-service-provision service)))
491 (#f (every obsolete? (live-service-dependents service)))
495 ;; Restart services that are currently running.
496 (filter running? target))
499 ;; Unload services that are no longer required. Essential services must
500 ;; be kept and transient services such as inetd child services should be
501 ;; kept as well--they'll vanish eventually.
502 (remove (lambda (live)
503 (or (essential? live)
504 (live-service-transient? live)))
505 (filter obsolete? live)))
507 (values to-unload to-restart))
514 (define %do-not-kill-file
515 ;; Name of the file listing PIDs of processes that must survive when halting
516 ;; the system. Typical example is user-space file systems.
517 "/etc/shepherd/do-not-kill")
519 (define (user-processes-shepherd-service requirements)
520 "Return the 'user-processes' Shepherd service with dependencies on
521 REQUIREMENTS (a list of service names).
523 This is a synchronization point used to make sure user processes and daemons
524 get started only after crucial initial services have been started---file
525 system mounts, etc. This is similar to the 'sysvinit' target in systemd."
527 ;; Delay after sending SIGTERM and before sending SIGKILL.
530 (list (shepherd-service
531 (documentation "When stopped, terminate all user processes.")
532 (provision '(user-processes))
533 (requirement requirements)
536 (define (kill-except omit signal)
537 ;; Kill all the processes with SIGNAL except those listed
538 ;; in OMIT and the current process.
539 (let ((omit (cons (getpid) omit)))
540 (for-each (lambda (pid)
541 (unless (memv pid omit)
547 ;; List of PIDs that must not be killed.
548 (if (file-exists? #$%do-not-kill-file)
550 (call-with-input-file #$%do-not-kill-file
551 (compose string-tokenize
552 (@ (ice-9 rdelim) read-string))))
556 (car (gettimeofday)))
559 ;; Really sleep N seconds.
560 ;; Work around <http://bugs.gnu.org/19581>.
562 (let loop ((elapsed 0))
564 (sleep (- n elapsed))
565 (loop (- (now) start)))))
567 (define lset= (@ (srfi srfi-1) lset=))
569 (display "sending all processes the TERM signal\n")
571 (if (null? omitted-pids)
573 ;; Easy: terminate all of them.
575 (sleep* #$grace-delay)
578 ;; Kill them all except OMITTED-PIDS. XXX: We would
579 ;; like to (kill -1 SIGSTOP) to get a fixed list of
580 ;; processes, like 'killall5' does, but that seems
582 (kill-except omitted-pids SIGTERM)
583 (sleep* #$grace-delay)
584 (kill-except omitted-pids SIGKILL)
585 (delete-file #$%do-not-kill-file)))
588 ;; Reap children, if any, so that we don't end up with
589 ;; zombies and enter an infinite loop.
590 (let reap-children ()
593 (waitpid WAIT_ANY (if (null? omitted-pids)
597 (when (and (pair? result)
598 (not (zero? (car result))))
601 (let ((pids (processes)))
602 (unless (lset= = pids (cons 1 omitted-pids))
603 (format #t "waiting for process termination\
604 (processes left: ~s)~%"
609 (display "all processes have been terminated\n")
613 (define user-processes-service-type
615 (name 'user-processes)
616 (extensions (list (service-extension shepherd-root-service-type
617 user-processes-shepherd-service)))
618 (compose concatenate)
621 ;; The value is the list of Shepherd services 'user-processes' depends on.
622 ;; Extensions can add new services to this list.
625 (description "The @code{user-processes} service is responsible for
626 terminating all the processes so that the root file system can be re-mounted
627 read-only, just before rebooting/halting. Processes still running after a few
628 seconds after @code{SIGTERM} has been sent are terminated with
631 ;;; shepherd.scm ends here