projects/guix·blob ruby-team · refs

816 lines · 32.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013-2016, 2018-2025 Ludovic Courtès <[email protected]>
3;;; Copyright © 2017 Clément Lassieur <[email protected]>
4;;; Copyright © 2018 Carlo Zancanaro <[email protected]>
5;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
6;;; Copyright © 2021 Maxime Devos <[email protected]>
7;;;
8;;; This file is part of GNU Guix.
9;;;
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.
14;;;
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.
19;;;
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/>.
22
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 utils)
31 #:use-module ((guix diagnostics)
32 #:select (define-with-syntax-properties formatted-message))
33 #:use-module (gnu services)
34 #:use-module (gnu services configuration)
35 #:use-module (gnu services herd)
36 #:use-module (gnu packages admin)
37 #:use-module (ice-9 match)
38 #:use-module (ice-9 vlist)
39 #:use-module (srfi srfi-1)
40 #:use-module (srfi srfi-26)
41 #:use-module (srfi srfi-34)
42 #:use-module (srfi srfi-35)
43 #:export (shepherd-configuration
44 shepherd-configuration?
45 shepherd-configuration-shepherd
46 shepherd-configuration-services
47
48 shepherd-root-service-type
49 %shepherd-root-service
50 shepherd-service-type
51
52 shepherd-service
53 shepherd-service?
54 shepherd-service-documentation
55 shepherd-service-provision
56 shepherd-service-canonical-name
57 shepherd-service-requirement
58 shepherd-service-one-shot?
59 shepherd-service-respawn-limit
60 shepherd-service-respawn-delay
61 shepherd-service-respawn?
62 shepherd-service-start
63 shepherd-service-stop
64 shepherd-service-free-form
65 shepherd-service-auto-start?
66 shepherd-service-modules
67
68 shepherd-action
69 shepherd-action?
70 shepherd-action-name
71 shepherd-action-documentation
72 shepherd-action-procedure
73
74 shepherd-signal-action
75 shepherd-configuration-action
76 shepherd-timer
77 shepherd-trigger-action
78
79 %default-modules
80
81 shepherd-service-file
82
83 shepherd-service-lookup-procedure
84 shepherd-service-back-edges
85 shepherd-service-upgrade
86
87 user-processes-service-type
88 shepherd-timer-service-type
89 shepherd-transient-service-type
90
91 system-log-configuration
92 system-log-configuration?
93 system-log-configuration-provision
94 system-log-configuration-requirement
95 system-log-configuration-message-destination
96 system-log-configuration-date-format
97 system-log-configuration-history-size
98 system-log-configuration-max-silent-time
99
100 shepherd-system-log-service-type
101
102 assert-valid-graph))
103
104;;; Commentary:
105;;;
106;;; Instantiating system services as a shepherd configuration file.
107;;;
108;;; Code:
109
110
111(define-record-type* <shepherd-configuration>
112 shepherd-configuration make-shepherd-configuration
113 shepherd-configuration?
114 (shepherd shepherd-configuration-shepherd
115 (default shepherd-1.0)) ;file-like
116 (services shepherd-configuration-services
117 (default '()))) ; list of <shepherd-service>
118
119(define (shepherd-boot-gexp config)
120 "Return a gexp starting the shepherd service."
121 (let ((shepherd (shepherd-configuration-shepherd config))
122 (services (shepherd-configuration-services config)))
123 #~(begin
124 ;; Keep track of the booted system.
125 (false-if-exception (delete-file "/run/booted-system"))
126
127 ;; Make /run/booted-system, an indirect GC root, point to the store item
128 ;; /run/current-system points to. Use 'canonicalize-path' rather than
129 ;; 'readlink' to make sure we get the store item.
130 (symlink (canonicalize-path "/run/current-system")
131 "/run/booted-system")
132
133 ;; Ensure open file descriptors are close-on-exec so shepherd doesn't
134 ;; inherit them.
135 (let loop ((fd 3))
136 (when (< fd 1024)
137 (false-if-exception
138 (let ((flags (fcntl fd F_GETFD)))
139 (when (zero? (logand flags FD_CLOEXEC))
140 (fcntl fd F_SETFD (logior FD_CLOEXEC flags)))))
141 (loop (+ fd 1))))
142
143 ;; Start shepherd.
144 (execl #$(file-append shepherd "/bin/shepherd")
145 "shepherd" "--config"
146 #$(shepherd-configuration-file services shepherd)))))
147
148(define shepherd-packages
149 (compose list shepherd-configuration-shepherd))
150
151(define shepherd-root-service-type
152 (service-type
153 (name 'shepherd-root)
154 ;; Extending the root shepherd service (aka. PID 1) happens by
155 ;; concatenating the list of services provided by the extensions.
156 (compose concatenate)
157 (extend (lambda (config extra-services)
158 (shepherd-configuration
159 (inherit config)
160 (services (append (shepherd-configuration-services config)
161 extra-services)))))
162 (extensions (list (service-extension boot-service-type
163 shepherd-boot-gexp)
164 (service-extension profile-service-type
165 shepherd-packages)))
166 (default-value (shepherd-configuration))
167 (description
168 "Run the GNU Shepherd as PID 1---i.e., the operating system's first
169process. The Shepherd takes care of managing services such as daemons by
170ensuring they are started and stopped in the right order.")))
171
172(define %shepherd-root-service
173 ;; The root shepherd service, aka. PID 1. Its parameter is a
174 ;; <shepherd-configuration>.
175 (service shepherd-root-service-type))
176
177(define-syntax shepherd-service-type
178 (syntax-rules (description)
179 "Return a <service-type> denoting a simple shepherd service--i.e., the type
180for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else. When
181DEFAULT is given, use it as the service's default value."
182 ((_ service-name proc default (description text))
183 (service-type
184 (name service-name)
185 (extensions
186 (list (service-extension shepherd-root-service-type
187 (compose list proc))))
188 (default-value default)
189 (description text)))
190 ((_ service-name proc (description text))
191 (service-type
192 (name service-name)
193 (extensions
194 (list (service-extension shepherd-root-service-type
195 (compose list proc))))
196 (description text)))))
197
198(define %default-imported-modules
199 ;; Default set of modules imported for a service's consumption.
200 '((guix build utils)
201 (guix build syscalls)))
202
203(define %default-modules
204 ;; Default set of modules visible in a service's file.
205 `((shepherd service)
206 ((guix build utils) #:hide (delete))
207 (guix build syscalls)))
208
209(define-with-syntax-properties (validate-provision (provision properties))
210 (match provision
211 (((? symbol?) ..1) provision)
212 (_
213 (raise
214 (make-compound-condition
215 (condition
216 (&error-location
217 (location (source-properties->location properties))))
218 (formatted-message
219 (G_ "'provision' must be a non-empty list of symbols")))))))
220
221(define-record-type* <shepherd-service>
222 shepherd-service make-shepherd-service
223 shepherd-service?
224 (documentation shepherd-service-documentation ;string
225 (default "[No documentation.]"))
226 (provision shepherd-service-provision ;list of symbols
227 (sanitize validate-provision))
228 (requirement shepherd-service-requirement ;list of symbols
229 (default '()))
230 (one-shot? shepherd-service-one-shot? ;Boolean
231 (default #f))
232 (respawn? shepherd-service-respawn? ;Boolean
233 (default #t))
234 (respawn-limit shepherd-service-respawn-limit
235 (default #f))
236 (respawn-delay shepherd-service-respawn-delay
237 (default #f))
238 (free-form shepherd-service-free-form ;#f | g-expression (service)
239 (default #f))
240 (start shepherd-service-start ;g-expression (procedure)
241 (default #~(const #t)))
242 (stop shepherd-service-stop ;g-expression (procedure)
243 (default #~(const #f)))
244 (actions shepherd-service-actions ;list of <shepherd-action>
245 (default '()))
246 (auto-start? shepherd-service-auto-start? ;Boolean
247 (default #t))
248 (modules shepherd-service-modules ;list of module names
249 (default %default-modules)))
250
251(define-record-type* <shepherd-action>
252 shepherd-action make-shepherd-action
253 shepherd-action?
254 (name shepherd-action-name) ;symbol
255 (procedure shepherd-action-procedure) ;gexp
256 (documentation shepherd-action-documentation)) ;string
257
258(define (shepherd-service-canonical-name service)
259 "Return the 'canonical name' of SERVICE."
260 (first (shepherd-service-provision service)))
261
262(define %default-timer-documentation
263 "Periodically run a command.") ;no i18n since it gets in the shepherd process
264
265(define* (shepherd-timer provision schedule command
266 #:key
267 (requirement '())
268 (documentation %default-timer-documentation))
269 "Return a Shepherd service with the given PROVISION periodically running
270COMMAND, a list-valued gexp, according to SCHEDULE, a string in Vixie cron
271syntax or a gexp providing a Shepherd calendar event. DOCUMENTATION is the
272string that appears when running 'herd doc SERVICE'."
273 (shepherd-service
274 (provision provision)
275 (requirement requirement)
276 (modules '((shepherd service timer)))
277 (start #~(make-timer-constructor
278 #$(if (string? schedule)
279 #~(cron-string->calendar-event #$schedule)
280 schedule)
281 (command '(#$@command))
282 #:wait-for-termination? #t))
283 (stop #~(make-timer-destructor))
284 (documentation documentation)
285 (actions (list shepherd-trigger-action))))
286
287(define (assert-valid-graph services)
288 "Raise an error if SERVICES does not define a valid shepherd service graph,
289for instance if a service requires a nonexistent service, or if more than one
290service uses a given name.
291
292These are constraints that shepherd's 'register-service' verifies but we'd
293better verify them here statically than wait until PID 1 halts with an
294assertion failure."
295 (define provisions
296 ;; The set of provisions (symbols). Bail out if a symbol is given more
297 ;; than once.
298 (fold (lambda (service set)
299 (define (assert-unique symbol)
300 (when (set-contains? set symbol)
301 (raise (condition
302 (&message
303 (message
304 (format #f (G_ "service '~a' provided more than once")
305 symbol)))))))
306
307 (for-each assert-unique (shepherd-service-provision service))
308 (fold set-insert set (shepherd-service-provision service)))
309 (setq 'shepherd)
310 services))
311
312 (define (assert-satisfied-requirements service)
313 ;; Bail out if the requirements of SERVICE aren't satisfied.
314 (for-each (lambda (requirement)
315 (unless (set-contains? provisions requirement)
316 (raise (condition
317 (&message
318 (message
319 (format #f (G_ "service '~a' requires '~a', \
320which is not provided by any service")
321 (match (shepherd-service-provision service)
322 ((head . _) head)
323 (_ service))
324 requirement)))))))
325 (shepherd-service-requirement service)))
326
327 (for-each assert-satisfied-requirements services))
328
329(define %store-characters
330 ;; Valid store characters; see 'checkStoreName' in the daemon.
331 (string->char-set
332 "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
333
334(define (shepherd-service-file-name service)
335 "Return the file name where the initialization code for SERVICE is to be
336stored."
337 (let ((provisions (string-join (map symbol->string
338 (shepherd-service-provision service)))))
339 (string-append "shepherd-"
340 (string-map (lambda (chr)
341 (if (char-set-contains? %store-characters chr)
342 chr
343 #\-))
344 provisions)
345 ".scm")))
346
347(define (shepherd-service-file/regular service)
348 "Return a file defining SERVICE, a service whose 'free-form' field is #f."
349 (scheme-file (shepherd-service-file-name service)
350 (with-imported-modules %default-imported-modules
351 #~(begin
352 (use-modules #$@(shepherd-service-modules service))
353
354 (service
355 '#$(shepherd-service-provision service)
356 #:documentation '#$(shepherd-service-documentation service)
357 #:requirement '#$(shepherd-service-requirement service)
358
359 ;; The 'one-shot?' slot is new in Shepherd 0.6.0.
360 ;; Older versions ignore it.
361 #:one-shot? '#$(shepherd-service-one-shot? service)
362
363 #:respawn? '#$(shepherd-service-respawn? service)
364 #$@(if (shepherd-service-respawn-limit service)
365 `(#:respawn-limit
366 ,(shepherd-service-respawn-limit service))
367 '())
368 #$@(if (shepherd-service-respawn-delay service)
369 `(#:respawn-delay
370 ,(shepherd-service-respawn-delay service))
371 '())
372 #:start #$(shepherd-service-start service)
373 #:stop #$(shepherd-service-stop service)
374 #:actions
375 (actions
376 #$@(map (match-lambda
377 (($ <shepherd-action> name proc doc)
378 #~(#$name #$doc #$proc)))
379 (shepherd-service-actions service))))))))
380
381(define (shepherd-service-file/free-form service)
382 "Return a file defining SERVICE, a service whose 'free-form' field is set."
383 (scheme-file (shepherd-service-file-name service)
384 (with-imported-modules %default-imported-modules
385 #~(begin
386 (use-modules #$@(shepherd-service-modules service))
387
388 #$(shepherd-service-free-form service)))))
389
390(define (shepherd-service-file service)
391 "Return a file defining SERVICE."
392 (if (shepherd-service-free-form service)
393 (shepherd-service-file/free-form service)
394 (shepherd-service-file/regular service)))
395
396(define (scm->go file shepherd)
397 "Compile FILE, which contains code to be loaded by shepherd's config file,
398and return the resulting '.go' file. SHEPHERD is used as shepherd package."
399 (define shepherd&co
400 (cons shepherd
401 (match (lookup-package-propagated-input shepherd "guile-fibers")
402 (#f '())
403 (fibers (list fibers)))))
404
405 (let-system (system target)
406 (with-extensions shepherd&co
407 (computed-file (string-append (basename (scheme-file-name file) ".scm")
408 ".go")
409 #~(begin
410 (use-modules (system base compile)
411 (system base target))
412
413 ;; Do the same as the Shepherd's 'load-in-user-module'.
414 (let ((env (make-fresh-user-module)))
415 (module-use! env (resolve-interface '(shepherd service)))
416 (with-target #$(or target #~%host-type)
417 (lambda _
418 (compile-file #$file #:output-file #$output
419 #:env env)))))
420
421 ;; It's faster to build locally than to download.
422 #:options '(#:local-build? #t
423 #:substitutable? #f)))))
424
425(define* (shepherd-signal-action
426 name signal
427 #:key
428 (documentation (format #f "Send signal ~a to the running service."
429 signal))
430 (message (format #f "Service has been asked to perform '~a'."
431 name)))
432 "Return a shepherd action with NAME to send SIGNAL to the running process.
433The documentation string of the action will be set to DOC.
434The action will print MESSAGE after sending the signal."
435 (shepherd-action
436 (name name)
437 (documentation documentation)
438 (procedure #~(lambda (running . args)
439 (if running
440 (let ((pid (process-id running)))
441 (kill pid #$signal)
442 (display #$message))
443 (display "Service is not running."))))))
444
445(define (shepherd-configuration-action file)
446 "Return a 'configuration' action to display FILE, which should be the name
447of the service's configuration file."
448 (shepherd-action
449 (name 'configuration)
450 (documentation "Display the name of this service's configuration file.")
451 (procedure #~(lambda (_)
452 (format #t "~a~%" #$file)
453 #$file))))
454
455(define shepherd-trigger-action
456 ;; Action to trigger a timer.
457 (shepherd-action
458 (name 'trigger)
459 (documentation "Trigger immediate execution of this timer.")
460 (procedure #~trigger-timer)))
461
462(define (shepherd-configuration-file services shepherd)
463 "Return the shepherd configuration file for SERVICES. SHEPHERD is used
464as shepherd package."
465 (assert-valid-graph services)
466
467 (let ((files (map shepherd-service-file services))
468 (scm->go (cute scm->go <> shepherd)))
469 (define config
470 #~(begin
471 (use-modules (srfi srfi-1))
472
473 (define (make-user-module)
474 ;; Copied from (shepherd support), where it's private.
475 (let ((m (make-fresh-user-module)))
476 (module-use! m (resolve-interface '(shepherd service)))
477 m))
478
479 ;; Specify the default environment visible to all the services.
480 ;; Without this statement, all the environment variables of PID 1
481 ;; are inherited by child services.
482 (default-environment-variables
483 '("PATH=/run/current-system/profile/bin"))
484
485 ;; Booting off a DVD, especially on a slow machine, can make
486 ;; everything slow. Thus, increase the timeout compared to the
487 ;; default 5s in the Shepherd 0.7.0. See
488 ;; <https://bugs.gnu.org/40572>.
489 (default-pid-file-timeout 30)
490
491 ;; Load service files one by one; filter out those that could not be
492 ;; loaded--e.g., due to an unbound variable--such that an error in
493 ;; one service definition does not prevent the system from booting.
494 (register-services
495 (parameterize ((current-warning-port (%make-void-port "w")))
496 (filter-map (lambda (file)
497 (with-exception-handler
498 (lambda (exception)
499 (format #t "Exception caught \
500while loading '~a': ~s~%"
501 file exception)
502 #f)
503 (lambda ()
504 (save-module-excursion
505 (lambda ()
506 (set-current-module (make-user-module))
507 (load-compiled file))))
508 #:unwind? #t))
509 '#$(map scm->go files))))
510
511 (format #t "starting services...~%")
512 (let ((services-to-start
513 '#$(append-map shepherd-service-provision
514 (filter shepherd-service-auto-start?
515 services))))
516 (start-in-the-background services-to-start)
517
518 ;; Hang up stdin. At this point, we assume that 'start' methods
519 ;; that required user interaction on the console (e.g.,
520 ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have
521 ;; completed. User interaction becomes impossible after this
522 ;; call; this avoids situations where services wrongfully lead
523 ;; PID 1 to read from stdin (the console), which users may not
524 ;; have access to (see <https://bugs.gnu.org/23697>).
525 (redirect-port (open "/dev/null" (logior O_RDONLY O_CLOEXEC))
526 (current-input-port)))))
527
528 (scheme-file "shepherd.conf" config)))
529
530(define* (shepherd-service-lookup-procedure services
531 #:optional
532 (provision
533 shepherd-service-provision))
534 "Return a procedure that, when passed a symbol, return the item among
535SERVICES that provides this symbol. PROVISION must be a one-argument
536procedure that takes a service and returns the list of symbols it provides."
537 (let ((services (fold (lambda (service result)
538 (fold (cut vhash-consq <> service <>)
539 result
540 (provision service)))
541 vlist-null
542 services)))
543 (lambda (name)
544 (match (vhash-assq name services)
545 ((_ . service) service)
546 (#f #f)))))
547
548(define* (shepherd-service-back-edges services
549 #:key
550 (provision shepherd-service-provision)
551 (requirement shepherd-service-requirement))
552 "Return a procedure that, when given a <shepherd-service> from SERVICES,
553returns the list of <shepherd-service> that depend on it.
554
555Use PROVISION and REQUIREMENT as one-argument procedures that return the
556symbols provided/required by a service."
557 (define provision->service
558 (shepherd-service-lookup-procedure services provision))
559
560 (define edges
561 (fold (lambda (service edges)
562 (fold (lambda (requirement edges)
563 (vhash-consq (provision->service requirement) service
564 edges))
565 edges
566 (requirement service)))
567 vlist-null
568 services))
569
570 (lambda (service)
571 (vhash-foldq* cons '() service edges)))
572
573(define (shepherd-service-upgrade live target)
574 "Return two values: the subset of LIVE (a list of <live-service>) that needs
575to be unloaded, and the subset of LIVE that needs to be restarted to complete
576their upgrade."
577 (define (essential? service)
578 (memq (first (live-service-provision service))
579 '(root shepherd)))
580
581 (define lookup-target
582 (shepherd-service-lookup-procedure target
583 shepherd-service-provision))
584
585 (define lookup-live
586 (shepherd-service-lookup-procedure live
587 live-service-provision))
588
589 (define live-service-dependents
590 (shepherd-service-back-edges live
591 #:provision live-service-provision
592 #:requirement live-service-requirement))
593
594 (define (obsolete? service)
595 (match (lookup-target (first (live-service-provision service)))
596 (#f (every obsolete? (live-service-dependents service)))
597 (_ #f)))
598
599 (define to-restart
600 ;; Restart services that appear in TARGET and are currently running.
601 (filter-map (lambda (service)
602 (and=> (any lookup-live
603 (shepherd-service-provision service))
604 (lambda (live)
605 (and (live-service-running live)
606 live))))
607 target))
608
609 (define to-unload
610 ;; Unload services that are no longer required. Essential services must
611 ;; be kept and transient services such as inetd child services should be
612 ;; kept as well--they'll vanish eventually.
613 (remove (lambda (live)
614 (or (essential? live)
615 (live-service-transient? live)))
616 (filter obsolete? live)))
617
618 (values to-unload to-restart))
619
620
621;;;
622;;; User processes.
623;;;
624
625(define (user-processes-shepherd-service requirements)
626 "Return the 'user-processes' Shepherd service with dependencies on
627REQUIREMENTS (a list of service names).
628
629This is a synchronization point used to make sure user processes and daemons
630get started only after crucial initial services have been started---file
631system mounts, etc. This is similar to the 'sysvinit' target in systemd."
632 (define grace-delay
633 ;; Delay after sending SIGTERM and before sending SIGKILL.
634 4)
635
636 (list (shepherd-service
637 (documentation "When stopped, terminate all user processes.")
638 (provision '(user-processes))
639 (requirement requirements)
640 (start #~(const #t))
641 (stop #~(lambda _
642 (display "sending all processes the TERM signal\n")
643
644 (kill -1 SIGTERM)
645 (sleep #$grace-delay)
646 (kill -1 SIGKILL)
647
648 (let wait ()
649 (let ((pids (processes)))
650 (unless (equal? '(1) pids)
651 (format #t "waiting for process termination\
652 (processes left: ~s)~%"
653 pids)
654 (sleep 1)
655 (wait))))
656
657 (display "all processes have been terminated\n")
658 #f))
659 (respawn? #f))))
660
661(define user-processes-service-type
662 (service-type
663 (name 'user-processes)
664 (extensions (list (service-extension shepherd-root-service-type
665 user-processes-shepherd-service)))
666 (compose concatenate)
667 (extend append)
668
669 ;; The value is the list of Shepherd services 'user-processes' depends on.
670 ;; Extensions can add new services to this list.
671 (default-value '())
672
673 (description "The @code{user-processes} service is responsible for
674terminating all the processes so that the root file system can be re-mounted
675read-only, just before rebooting/halting. Processes still running after a few
676seconds after @code{SIGTERM} has been sent are terminated with
677@code{SIGKILL}.")))
678
679
680;;;
681;;; Timer and transient service maker.
682;;;
683
684(define shepherd-timer-service-type
685 (shepherd-service-type
686 'shepherd-timer
687 (lambda (requirement)
688 (shepherd-service
689 (provision '(timer))
690 (requirement requirement)
691 (modules '((shepherd service timer)))
692 (free-form #~(timer-service
693 '#$provision
694 #:requirement '#$requirement))))
695 '(user-processes)
696 (description "The Shepherd @code{timer} service lets you schedule commands
697dynamically, similar to the @code{at} command that your grandparents would use
698on that Slackware they got on a floppy disk. For example, consider this
699command:
700
701@example
702herd schedule timer at 07:00 -- mpg123 Music/alarm.mp3
703@end example
704
705It does exactly what you would expect.")))
706
707(define shepherd-transient-service-type
708 (shepherd-service-type
709 'shepherd-transient
710 (lambda (requirement)
711 (shepherd-service
712 (provision '(transient))
713 (requirement requirement)
714 (modules '((shepherd service transient)))
715 (free-form #~(transient-service
716 '#$provision
717 #:requirement '#$requirement))))
718 '(user-processes)
719 (description "The Shepherd @code{transient} service lets you run commands
720asynchronously, in the background, similar to @command{systemd-run}, as in
721this example:
722
723@example
724herd spawn transient -E SSH_AUTH_SOCK=$SSH_AUTH_SOCK -- \\
725 rsync -e ssh -vur . backup.example.org:
726@end example
727
728This runs @command{rsync} in the background, as a service that you can inspect
729with @command{herd status} and stop with @command{herd stop}.")))
730
731
732;;;
733;;; System log.
734;;;
735
736(define (gexp-or-false? x)
737 (or (gexp? x) (not x)))
738
739(define (gexp-or-integer? x)
740 (or (gexp? x) (integer? x)))
741
742(define (gexp-or-integer-or-false? x)
743 (or (not x) (gexp-or-integer? x)))
744
745(define (gexp-or-string? x)
746 (or (gexp? x) (string? x)))
747
748(define (gexp-or-string-or-false? x)
749 (or (gexp-or-string? x) (not x)))
750
751(define-configuration/no-serialization system-log-configuration
752 (provision
753 (list-of-symbols '(system-log syslogd))
754 "The name(s) of the system log service.")
755 (requirement
756 (list-of-symbols '(root-file-system))
757 "Dependencies of the system log service.")
758 (kernel-log-file
759 (gexp-or-string-or-false #~(kernel-log-file))
760 "File from which kernel messages are read, @file{/dev/kmsg} by default.")
761 (message-destination
762 (gexp-or-false #f)
763 "This gexp must evaluate to a procedure that, when passed a log message,
764returns the list of files to write it to; @code{#f} is equivalent to using
765@code{(default-message-destination-procedure)}. @xref{System Log Service,,,
766shepherd, The GNU Shepherd Manual}, for information on how to write that
767procedure.")
768 (date-format
769 (gexp-or-string #~default-logfile-date-format)
770 "String or string-valued gexp specifying how to format timestamps in log
771files. It must be a valid string for @code{strftime} (@pxref{Time,,, guile,
772GNU Guile Reference Manual}), including delimiting space---e.g., @code{\"%c
773\"} for a format identical to that of traditional syslogd implementations.")
774 (history-size
775 (gexp-or-integer #~(default-log-history-size))
776 "Number of logging messages kept in memory for the purposes of making them
777available to @command{herd status system-log}.")
778 (max-silent-time
779 (gexp-or-integer-or-false #~(default-max-silent-time))
780 "Time after which a mark is written to log files if nothing was logged
781during that time frame. When set to @code{#f}, this feature is disabled."))
782
783(define shepherd-system-log-service-type
784 (shepherd-service-type
785 'shepherd-system-log
786 (lambda (config)
787 (match-record config <system-log-configuration>
788 (provision requirement message-destination
789 date-format history-size max-silent-time)
790 (shepherd-service
791 (documentation "Shepherd's built-in system log (syslogd).")
792 (provision (system-log-configuration-provision config))
793 (requirement (system-log-configuration-requirement config))
794 (modules '((shepherd service system-log)
795 ((shepherd support) #:select (default-logfile-date-format))
796 ((shepherd logger) #:select (default-log-history-size))))
797 (free-form
798 #~(system-log-service #:provision '#$provision
799 #:requirement '#$requirement
800
801 ;; XXX: As of Shepherd 1.0.1,
802 ;; 'default-message-destination-procedure' is not
803 ;; exported, hence this conditional.
804 #$@(match message-destination
805 (#f #~())
806 (value #~(#:message-destination #$value)))
807
808 #:date-format #$date-format
809 #:history-size #$history-size
810 #:max-silent-time #$max-silent-time)))))
811 (system-log-configuration)
812 (description
813 "The Shepherd's @code{system-log} service plays the role of traditional
814@command{syslogd} program, reading data logged by daemons to @file{/dev/log}
815and writing it to several files in @file{/var/log} according to user-provided
816dispatching rules.")))