projects/guix·blob python-team · refs

839 lines · 33.6 KiB

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