projects/guix·blob java-team · refs

1267 lines · 42.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Peter Mikkelsen <[email protected]>
3;;; Copyright © 2019 Ricardo Wurmus <[email protected]>
4;;; Copyright © 2020 Ludovic Courtès <[email protected]>
5;;; Copyright © 2022⁠–⁠2023 Bruno Victal <[email protected]>
6;;;
7;;; This file is part of GNU Guix.
8;;;
9;;; GNU Guix is free software; you can redistribute it and/or modify it
10;;; under the terms of the GNU General Public License as published by
11;;; the Free Software Foundation; either version 3 of the License, or (at
12;;; your option) any later version.
13;;;
14;;; GNU Guix is distributed in the hope that it will be useful, but
15;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;;; GNU General Public License for more details.
18;;;
19;;; You should have received a copy of the GNU General Public License
20;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21
22(define-module (gnu services audio)
23 #:use-module (guix gexp)
24 #:use-module (guix deprecation)
25 #:use-module (guix diagnostics)
26 #:use-module (guix i18n)
27 #:use-module (guix modules)
28 #:use-module ((gnu services) #:hide (delete))
29 #:use-module (gnu services admin)
30 #:use-module (gnu services configuration)
31 #:use-module (gnu services shepherd)
32 #:use-module (gnu services admin)
33 #:use-module (gnu system shadow)
34 #:use-module (gnu packages admin)
35 #:use-module ((gnu packages audio) #:select (snapcast))
36 #:use-module (gnu packages mpd)
37 #:use-module (guix records)
38 #:use-module (ice-9 format)
39 #:use-module (ice-9 match)
40 #:use-module (srfi srfi-1)
41 #:use-module (srfi srfi-26)
42 #:use-module (srfi srfi-71)
43 #:export (mpd-output
44 mpd-output?
45 mpd-output-name
46 mpd-output-type
47 mpd-output-enabled?
48 mpd-output-format
49 mpd-output-tags?
50 mpd-output-always-on?
51 mpd-output-mixer-type
52 mpd-output-replay-gain-handler
53 mpd-output-extra-options
54
55 mpd-plugin
56 mpd-plugin?
57 mpd-plugin-plugin
58 mpd-plugin-name
59 mpd-plugin-enabled?
60 mpd-plugin-extra-options
61
62 mpd-partition
63 mpd-partition?
64 mpd-partition-name
65 mpd-partition-extra-options
66
67 %mpd-user
68 %mpd-group
69
70 mpd-configuration
71 mpd-configuration?
72 mpd-configuration-package
73 mpd-configuration-user
74 mpd-configuration-group
75 mpd-configuration-shepherd-requirement
76 mpd-configuration-log-file
77 mpd-configuration-log-level
78 mpd-configuration-music-directory
79 mpd-configuration-music-dir
80 mpd-configuration-playlist-directory
81 mpd-configuration-playlist-dir
82 mpd-configuration-db-file
83 mpd-configuration-state-file
84 mpd-configuration-sticker-file
85 mpd-configuration-default-port
86 mpd-configuration-endpoints
87 mpd-configuration-address
88 mpd-configuration-database
89 mpd-configuration-partitions
90 mpd-configuration-neighbors
91 mpd-configuration-inputs
92 mpd-configuration-archive-plugins
93 mpd-configuration-input-cache-size
94 mpd-configuration-decoders
95 mpd-configuration-resampler
96 mpd-configuration-filters
97 mpd-configuration-outputs
98 mpd-configuration-playlist-plugins
99 mpd-configuration-extra-options
100 mpd-service-type
101
102 mympd-service-type
103 mympd-configuration
104 mympd-configuration?
105 mympd-configuration-package
106 mympd-configuration-shepherd-requirement
107 mympd-configuration-user
108 mympd-configuration-group
109 mympd-configuration-work-directory
110 mympd-configuration-cache-directory
111 mympd-configuration-acl
112 mympd-configuration-covercache-ttl
113 mympd-configuration-http?
114 mympd-configuration-host
115 mympd-configuration-port
116 mympd-configuration-log-level
117 mympd-configuration-log-to
118 mympd-configuration-lualibs
119 mympd-configuration-uri
120 mympd-configuration-script-acl
121 mympd-configuration-ssl?
122 mympd-configuration-ssl-port
123 mympd-configuration-ssl-cert
124 mympd-configuration-ssl-key
125 mympd-configuration-pin-hash
126 mympd-configuration-save-caches?
127 mympd-ip-acl
128 mympd-ip-acl?
129 mympd-ip-acl-allow
130 mympd-ip-acl-deny
131
132 snapserver-stream
133 snapserver-stream?
134 snapserver-stream-name
135 snapserver-stream-type
136 snapserver-stream-location
137 snapserver-stream-codec
138 snapserver-stream-sampleformat
139 snapserver-stream-chunk-ms
140 snapserver-stream-parameters
141
142 snapserver-configuration
143 snapserver-configuration?
144 snapserver-configuration-package
145 snapserver-configuration-user
146 snapserver-configuration-group
147 snapserver-configuration-shepherd-requirement
148 snapserver-configuration-log-file
149 snapserver-configuration-log-filter
150 snapserver-configuration-data-directory
151 snapserver-configuration-mdns?
152 snapserver-configuration-http?
153 snapserver-configuration-http-port
154 snapserver-configuration-http-bind-address
155 snapserver-configuration-doc-root
156 snapserver-configuration-tcp-control?
157 snapserver-configuration-tcp-control-port
158 snapserver-configuration-tcp-streaming?
159 snapserver-configuration-tcp-streaming-port
160 snapserver-configuration-streams
161 snapserver-configuration-codec
162 snapserver-configuration-sampleformat
163 snapserver-configuration-buffer-ms
164 snapserver-configuration-chunk-ms
165 snapserver-configuration-send-to-muted?
166 snapserver-configuration-extra-content
167 snapserver-service-type))
168
169;;; Commentary:
170;;;
171;;; Audio related services
172;;;
173;;; Code:
174
175(define (uglify-field-name field-name)
176 (let ((str (symbol->string field-name)))
177 (string-join (string-split (if (string-suffix? "?" str)
178 (string-drop-right str 1)
179 str)
180 #\-) "_")))
181
182
183;;;
184;;; MPD
185;;;
186
187(define (mpd-serialize-field field-name value)
188 (let ((field (if (string? field-name) field-name
189 (uglify-field-name field-name)))
190 (value (cond
191 ((boolean? value) (if value "yes" "no"))
192 ((string? value) value)
193 (else (object->string value)))))
194 #~(format #f "~a ~s~%" #$field #$value)))
195
196(define (mpd-serialize-alist field-name value)
197 #~(string-append #$@(generic-serialize-alist list mpd-serialize-field
198 value)))
199
200(define mpd-serialize-string mpd-serialize-field)
201(define mpd-serialize-boolean mpd-serialize-field)
202
203(define (mpd-serialize-list-of-strings field-name value)
204 #~(string-append #$@(map (cut mpd-serialize-string field-name <>) value)))
205
206(define (mpd-serialize-user-account field-name value)
207 (mpd-serialize-string field-name (user-account-name value)))
208
209(define-maybe string (prefix mpd-))
210(define-maybe list-of-strings (prefix mpd-))
211(define-maybe boolean (prefix mpd-))
212(define mpd-serialize-user-group empty-serializer) ; So define-maybe doesn't warn.
213(define-maybe user-group (prefix mpd-))
214
215(define %mpd-group
216 (user-group
217 (name "mpd")
218 (system? #t)))
219
220(define %mpd-user
221 (user-account
222 (name "mpd")
223 (group (user-group-name %mpd-group))
224 (system? #t)
225 (comment "Music Player Daemon (MPD) user")
226 ;; MPD can use $HOME (or $XDG_CONFIG_HOME) to place its data.
227 (home-directory "/var/lib/mpd")
228 (shell (file-append shadow "/sbin/nologin"))))
229
230(define (port? value) (or (string? value) (integer? value)))
231
232(define (mpd-serialize-port field-name value)
233 (when (string? value)
234 (warning
235 (G_ "string value for '~a' is deprecated, use integer instead~%")
236 field-name))
237 (mpd-serialize-field "port" value))
238
239(define-maybe port (prefix mpd-))
240
241;;; Procedures for unsupported value types, to be removed.
242
243(define (mpd-user-account-sanitizer value)
244 (cond ((user-account? value) value)
245 ((string? value)
246 (warning (G_ "string value for 'user' is deprecated, use \
247user-account instead~%"))
248 (user-account
249 (inherit %mpd-user)
250 (name value)))
251 (else
252 (configuration-field-error #f 'user value))))
253
254(define (mpd-user-group-sanitizer value)
255 (when (maybe-value-set? value)
256 (warning (G_ "mpd-configuration field 'group' is deprecated, \
257provide a user-account with group membership instead~%"))))
258
259(define (mpd-log-file-sanitizer value)
260 ;; XXX: While leaving the 'sys_log' option out of the mpd.conf file is
261 ;; supposed to cause logging to happen via systemd (elogind provides a
262 ;; compatible interface), this doesn't work (nothing gets logged); use
263 ;; syslog instead.
264 (let ((value (maybe-value value "syslog")))
265 (if (string? value)
266 value
267 (configuration-field-error #f 'log-file value))))
268
269;;;
270
271;; Generic MPD plugin record, lists only the most prevalent fields.
272(define-configuration mpd-plugin
273 (plugin
274 maybe-string
275 "Plugin name.")
276
277 (name
278 maybe-string
279 "Name.")
280
281 (enabled?
282 maybe-boolean
283 "Whether the plugin is enabled/disabled.")
284
285 (extra-options
286 (alist '())
287 "An association list of option symbols/strings to string values
288to be appended to the plugin configuration. See
289@uref{https://mpd.readthedocs.io/en/latest/plugins.html,MPD plugin reference}
290for available options.")
291
292 (prefix mpd-))
293
294(define (mpd-serialize-mpd-plugin field-name value)
295 #~(format #f "~a {~%~a}~%"
296 '#$field-name
297 #$(serialize-configuration value mpd-plugin-fields)))
298
299(define (mpd-serialize-list-of-mpd-plugin field-name value)
300 #~(string-append #$@(map (cut mpd-serialize-mpd-plugin field-name <>)
301 value)))
302
303(define list-of-mpd-plugin? (list-of mpd-plugin?))
304
305(define-maybe mpd-plugin (prefix mpd-))
306
307(define-configuration mpd-partition
308 (name
309 string
310 "Partition name.")
311
312 (extra-options
313 (alist '())
314 "An association list of option symbols/strings to string values
315to be appended to the partition configuration. See
316@uref{https://mpd.readthedocs.io/en/latest/user.html#configuring-partitions,Configuring Partitions}
317for available options.")
318
319 (prefix mpd-))
320
321(define (mpd-serialize-mpd-partition field-name value)
322 #~(format #f "partition {~%~a}~%"
323 #$(serialize-configuration value mpd-partition-fields)))
324
325(define (mpd-serialize-list-of-mpd-partition field-name value)
326 #~(string-append #$@(map (cut mpd-serialize-mpd-partition #f <>) value)))
327
328(define list-of-mpd-partition?
329 (list-of mpd-partition?))
330
331(define-configuration mpd-output
332 (name
333 (string "MPD")
334 "The name of the audio output.")
335
336 (type
337 (string "pulse")
338 "The type of audio output.")
339
340 (enabled?
341 (boolean #t)
342 "Specifies whether this audio output is enabled when MPD is started. By
343default, all audio outputs are enabled. This is just the default
344setting when there is no state file; with a state file, the previous
345state is restored.")
346
347 (format
348 maybe-string
349 "Force a specific audio format on output. See
350@uref{https://mpd.readthedocs.io/en/latest/user.html#audio-output-format,Global Audio Format}
351for a more detailed description.")
352
353 (tags?
354 (boolean #t)
355 "If set to @code{#f}, then MPD will not send tags to this output. This
356is only useful for output plugins that can receive tags, for example the
357@code{httpd} output plugin.")
358
359 (always-on?
360 (boolean #f)
361 "If set to @code{#t}, then MPD attempts to keep this audio output always
362open. This may be useful for streaming servers, when you don’t want to
363disconnect all listeners even when playback is accidentally stopped.")
364
365 (mixer-type
366 maybe-string
367 "This field accepts a string that specifies which mixer should be used for
368this audio output: the @code{hardware} mixer, the @code{software} mixer, the
369@code{null} mixer (allows setting the volume, but with no effect; this can be
370used as a trick to implement an external mixer External Mixer) or no
371mixer (@code{none}). When left unspecified, a @code{hardware} mixer is used
372for devices that support it."
373 (sanitizer
374 (lambda (x) ; TODO: deprecated, remove me later.
375 (cond
376 ((eq? %unset-value x)
377 x)
378 ((symbol? x)
379 (warning (G_ "symbol value for 'mixer-type' is deprecated, \
380use string instead~%"))
381 (symbol->string x))
382 ((string? x) x)
383 (else
384 (configuration-field-error #f 'mixer-type x))))))
385
386 (replay-gain-handler
387 maybe-string
388 "This field accepts a string that specifies how
389@uref{https://mpd.readthedocs.io/en/latest/user.html#replay-gain,Replay Gain}
390is to be applied. @code{software} uses an internal software volume control,
391@code{mixer} uses the configured (hardware) mixer control and @code{none}
392disables replay gain on this audio output.")
393
394 (extra-options
395 (alist '())
396 "An association list of option symbols/strings to string values
397to be appended to the audio output configuration.")
398
399 (prefix mpd-))
400
401(define (mpd-serialize-mpd-output field-name value)
402 #~(format #f "audio_output {~%~a}~%"
403 #$(serialize-configuration value mpd-output-fields)))
404
405(define (mpd-serialize-list-of-mpd-plugin-or-output field-name value)
406 (let ((plugins outputs (partition mpd-plugin? value)))
407 #~(string-append #$@(map (cut mpd-serialize-mpd-plugin "audio_output" <>)
408 plugins)
409 #$@(map (cut mpd-serialize-mpd-output #f <>) outputs))))
410
411(define list-of-mpd-plugin-or-output?
412 (list-of (lambda (x)
413 (or (mpd-output? x) (mpd-plugin? x)))))
414
415(define-configuration mpd-configuration
416 (package
417 (file-like mpd)
418 "The MPD package."
419 empty-serializer)
420
421 (user
422 (user-account %mpd-user)
423 "The user to run mpd as."
424 (sanitizer mpd-user-account-sanitizer))
425
426 (group
427 maybe-user-group
428 "The group to run mpd as. Deprecated, do not use."
429 (sanitizer mpd-user-group-sanitizer)
430 (serializer empty-serializer))
431
432 (shepherd-requirement
433 (list-of-symbols '())
434 "This is a list of symbols naming Shepherd services that this service
435will depend on."
436 empty-serializer)
437
438 (environment-variables
439 (list-of-strings '("PULSE_CLIENTCONFIG=/etc/pulse/client.conf"
440 "PULSE_CONFIG=/etc/pulse/daemon.conf"))
441 "A list of strings specifying environment variables."
442 empty-serializer)
443
444 (log-file
445 maybe-string
446 "The location of the log file. Unless specified, logs are sent to the
447local syslog daemon. Alternatively, a log file name can be specified, for
448example @file{/var/log/mpd.log}."
449 (sanitizer mpd-log-file-sanitizer))
450
451 (log-level
452 maybe-string
453 "Suppress any messages below this threshold.
454The available values, in decreasing order of verbosity, are: @code{verbose},
455@code{info}, @code{notice}, @code{warning} and @code{error}.")
456
457 (music-directory
458 maybe-string
459 "The directory to scan for music files.")
460
461 (playlist-directory
462 maybe-string
463 "The directory to store playlists.")
464
465 (db-file
466 maybe-string
467 "The location of the music database. When left unspecified,
468@file{~/.cache/db} is used.")
469
470 (state-file
471 maybe-string
472 "The location of the file that stores current MPD's state.")
473
474 (sticker-file
475 maybe-string
476 "The location of the sticker database.")
477
478 (default-port
479 (maybe-port 6600)
480 "The default port to run mpd on.")
481
482 (endpoints
483 maybe-list-of-strings
484 "The addresses that mpd will bind to. A port different from
485@var{default-port} may be specified, e.g. @code{localhost:6602} and
486IPv6 addresses must be enclosed in square brackets when a different
487port is used.
488To use a Unix domain socket, an absolute path or a path starting with @code{~}
489can be specified here."
490 (serializer
491 (lambda (_ endpoints)
492 (if (maybe-value-set? endpoints)
493 (mpd-serialize-list-of-strings "bind_to_address" endpoints)
494 ""))))
495
496 (database
497 maybe-mpd-plugin
498 "MPD database plugin configuration.")
499
500 (partitions
501 (list-of-mpd-partition '())
502 "List of MPD \"partitions\".")
503
504 (neighbors
505 (list-of-mpd-plugin '())
506 "List of MPD neighbor plugin configurations.")
507
508 (inputs
509 (list-of-mpd-plugin '())
510 "List of MPD input plugin configurations."
511 (serializer (lambda (_ x)
512 (mpd-serialize-list-of-mpd-plugin "input" x))))
513
514 (archive-plugins
515 (list-of-mpd-plugin '())
516 "List of MPD archive plugin configurations."
517 (serializer (lambda (_ x)
518 (mpd-serialize-list-of-mpd-plugin "archive_plugin" x))))
519
520 (auto-update?
521 maybe-boolean
522 "Whether to automatically update the music database when files are changed
523in the @var{music-directory}.")
524
525 (input-cache-size
526 maybe-string
527 "MPD input cache size."
528 (serializer (lambda (_ x)
529 (if (maybe-value-set? x)
530 #~(string-append "\ninput_cache {\n"
531 #$(mpd-serialize-string "size" x)
532 "}\n") ""))))
533
534 (decoders
535 (list-of-mpd-plugin '())
536 "List of MPD decoder plugin configurations."
537 (serializer (lambda (_ x)
538 (mpd-serialize-list-of-mpd-plugin "decoder" x))))
539
540 (resampler
541 maybe-mpd-plugin
542 "MPD resampler plugin configuration.")
543
544 (filters
545 (list-of-mpd-plugin '())
546 "List of MPD filter plugin configurations."
547 (serializer (lambda (_ x)
548 (mpd-serialize-list-of-mpd-plugin "filter" x))))
549
550 (outputs
551 (list-of-mpd-plugin-or-output (list (mpd-output)))
552 "The audio outputs that MPD can use.
553By default this is a single output using pulseaudio.")
554
555 (playlist-plugins
556 (list-of-mpd-plugin '())
557 "List of MPD playlist plugin configurations."
558 (serializer (lambda (_ x)
559 (mpd-serialize-list-of-mpd-plugin "playlist_plugin" x))))
560
561 (extra-options
562 (alist '())
563 "An association list of option symbols/strings to string values to be
564appended to the configuration.")
565
566 (prefix mpd-))
567
568(define (mpd-serialize-configuration configuration)
569 (mixed-text-file
570 "mpd.conf"
571 (serialize-configuration configuration mpd-configuration-fields)))
572
573(define (mpd-shepherd-service config)
574 (match-record config <mpd-configuration>
575 (user package shepherd-requirement
576 log-file playlist-directory
577 db-file state-file sticker-file
578 environment-variables)
579 (let ((config-file (mpd-serialize-configuration config))
580 (username (user-account-name user)))
581 (shepherd-service
582 (documentation "Run the MPD (Music Player Daemon)")
583 (requirement `(user-processes loopback
584 ,@(if (string=? "syslog" log-file)
585 '(syslogd)
586 '())
587 ,@shepherd-requirement))
588 (provision '(mpd))
589 (start
590 (with-imported-modules (source-module-closure
591 '((gnu build activation)))
592 #~(begin
593 (use-modules (gnu build activation))
594
595 (let ((home #$(user-account-home-directory user)))
596 (let ((user (getpw #$username))
597 (default-cache-dir (string-append home "/.cache")))
598
599 (define (init-directory directory)
600 (unless (file-exists? directory)
601 (mkdir-p/perms directory user #o755)))
602
603 ;; Define a cache location that can be automatically used
604 ;; for the database file, in case it hasn't been explicitly
605 ;; specified.
606 (for-each
607 init-directory
608 (cons default-cache-dir
609 '#$(map dirname
610 ;; XXX: Delete the potential "syslog"
611 ;; log-file value, which is not a directory.
612 (delete "syslog"
613 (filter-map maybe-value
614 (list db-file
615 log-file
616 state-file
617 sticker-file)))))))
618
619 (make-forkexec-constructor
620 (list #$(file-append package "/bin/mpd") "--no-daemon"
621 #$config-file)
622 #:environment-variables
623 ;; Set HOME so MPD can infer default paths, such as
624 ;; for the database file.
625 (cons* (string-append "HOME=" home)
626 "SSL_CERT_DIR=/run/current-system/profile/etc/ssl/certs"
627 "SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt"
628 '#$environment-variables))))))
629 (stop #~(make-kill-destructor))
630 (actions
631 (list (shepherd-configuration-action config-file)
632 (shepherd-signal-action
633 'reopen SIGHUP
634 #:documentation "Re-open log files and flush caches."
635 #:message "Issued SIGHUP to Service MPD.")))))))
636
637(define (mpd-accounts config)
638 (match-record config <mpd-configuration> (user)
639 (if (string=? (user-account-group user) (user-group-name %mpd-group))
640 (list %mpd-group user)
641 (list user))))
642
643(define mpd-service-type
644 (service-type
645 (name 'mpd)
646 (description "Run the Music Player Daemon (MPD).")
647 (extensions
648 (list (service-extension shepherd-root-service-type
649 (compose list mpd-shepherd-service))
650 (service-extension account-service-type mpd-accounts)))
651 (default-value (mpd-configuration))))
652
653
654;;;
655;;; myMPD
656;;;
657
658;; Helpers for deprecated field types, to be removed later.
659(define %lazy-group (make-symbol "%lazy-group"))
660
661(define (set-user-group user group)
662 (user-account
663 (inherit user)
664 (group (user-group-name group))))
665
666(define (string-or-symbol? x)
667 (or (symbol? x) (string? x)))
668
669(define-configuration/no-serialization mympd-ip-acl
670 (allow
671 (list-of-strings '())
672 "Allowed IP addresses.")
673
674 (deny
675 (list-of-strings '())
676 "Disallowed IP addresses."))
677
678(define-maybe/no-serialization integer)
679(define-maybe/no-serialization mympd-ip-acl)
680
681(define %mympd-user
682 (user-account
683 (name "mympd")
684 ;; XXX: This is a place-holder to be lazily substituted in 'mympd-accounts'
685 ;; with the value from the 'group' field of <mympd-configuration>.
686 (group %lazy-group)
687 (system? #t)
688 (comment "myMPD user")
689 (home-directory "/var/empty")
690 (shell (file-append shadow "/sbin/nologin"))))
691
692(define %mympd-group
693 (user-group
694 (name "mympd")
695 (system? #t)))
696
697;;; TODO: Procedures for unsupported value types, to be removed.
698(define (mympd-user-sanitizer value)
699 (cond ((user-account? value) value)
700 ((string? value)
701 (warning (G_ "string value for 'user' is not supported, use \
702user-account instead~%"))
703 (user-account
704 (inherit %mympd-user)
705 (name value)))
706 (else
707 (configuration-field-error #f 'user value))))
708
709(define (mympd-group-sanitizer value)
710 (cond ((user-group? value) value)
711 ((string? value)
712 (warning (G_ "string value for 'group' is not supported, use \
713user-group instead~%"))
714 (user-group
715 (inherit %mympd-group)
716 (name value)))
717 (else
718 (configuration-field-error #f 'group value))))
719
720(define (mympd-log-to-sanitizer value)
721 (match value
722 ('syslog
723 (warning (G_ "syslog symbol value for 'log-to' is deprecated~%"))
724 %unset-value)
725 ((or %unset-value (? string?))
726 value)
727 (_ (configuration-field-error #f 'log-to value))))
728
729;; XXX: The serialization procedures are insufficient since we require
730;; access to multiple fields at once.
731;; Fields marked with empty-serializer are never serialized and are
732;; used for command-line arguments or by the service definition.
733(define-configuration/no-serialization mympd-configuration
734 (package
735 (file-like mympd)
736 "The package object of the myMPD server."
737 empty-serializer)
738
739 (shepherd-requirement
740 (list-of-symbols '())
741 "This is a list of symbols naming Shepherd services that this service
742will depend on."
743 empty-serializer)
744
745 (user
746 (user-account %mympd-user)
747 "Owner of the @command{mympd} process."
748 (sanitizer mympd-user-sanitizer)
749 empty-serializer)
750
751 (group
752 (user-group %mympd-group)
753 "Owner group of the @command{mympd} process."
754 (sanitizer mympd-group-sanitizer)
755 empty-serializer)
756
757 (work-directory
758 (string "/var/lib/mympd")
759 "Where myMPD will store its data."
760 empty-serializer)
761
762 (cache-directory
763 (string "/var/cache/mympd")
764 "Where myMPD will store its cache."
765 empty-serializer)
766
767 (acl
768 maybe-mympd-ip-acl
769 "ACL to access the myMPD webserver.")
770
771 (covercache-ttl
772 (maybe-integer 31)
773 "How long to keep cached covers, @code{0} disables cover caching.")
774
775 (http?
776 (boolean #t)
777 "HTTP support.")
778
779 (host
780 (string "[::]")
781 "Host name to listen on.")
782
783 (port
784 (maybe-port 80)
785 "HTTP port to listen on.")
786
787 (log-level
788 (integer 5)
789 "How much detail to include in logs, possible values: @code{0} to @code{7}.")
790
791 (log-to
792 maybe-string
793 "Where to send logs. Unless specified, the service logs to the local
794syslog service under the @samp{daemon} facility. Alternatively, a log file
795name can be specified, for example @file{/var/log/mympd.log}."
796 (sanitizer mympd-log-to-sanitizer)
797 empty-serializer)
798
799 (lualibs
800 (maybe-string "all")
801 "See
802@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.")
803
804 (uri
805 maybe-string
806 "Override URI to myMPD.
807See @url{https://github.com/jcorporation/myMPD/issues/950}.")
808
809 (script-acl
810 (maybe-mympd-ip-acl (mympd-ip-acl
811 (allow '("127.0.0.1"))))
812 "ACL to access the myMPD script backend.")
813
814 (ssl?
815 (boolean #f)
816 "SSL/TLS support.")
817
818 (ssl-port
819 (maybe-port 443)
820 "Port to listen for HTTPS.")
821
822 (ssl-cert
823 maybe-string
824 "Path to PEM encoded X.509 SSL/TLS certificate (public key).")
825
826 (ssl-key
827 maybe-string
828 "Path to PEM encoded SSL/TLS private key.")
829
830 (pin-hash
831 maybe-string
832 "SHA-256 hashed pin used by myMPD to control settings access by
833prompting a pin from the user.")
834
835 (save-caches?
836 maybe-boolean
837 "Whether to preserve caches between service restarts."))
838
839(define (mympd-serialize-configuration config)
840 (define serialize-value
841 (match-lambda
842 ((? boolean? val) (if val "true" "false"))
843 ((? integer? val) (number->string val))
844 ((? mympd-ip-acl? val) (ip-acl-serialize-configuration val))
845 ((? string? val) val)))
846
847 (define (ip-acl-serialize-configuration config)
848 (define (serialize-list-of-strings prefix lst)
849 (map (cut format #f "~a~a" prefix <>) lst))
850 (string-join
851 (append
852 (serialize-list-of-strings "+" (mympd-ip-acl-allow config))
853 (serialize-list-of-strings "-" (mympd-ip-acl-deny config))) ","))
854
855 ;; myMPD configuration fields are serialized as individual files under
856 ;; <work-directory>/config/.
857 (match-record config <mympd-configuration> (work-directory acl
858 covercache-ttl http? host port
859 log-level lualibs uri script-acl
860 ssl? ssl-port ssl-cert ssl-key
861 pin-hash save-caches?)
862 (define (serialize-field filename value)
863 (when (maybe-value-set? value)
864 (list (format #f "~a/config/~a" work-directory filename)
865 (mixed-text-file filename (serialize-value value)))))
866
867 (let ((filename-to-field `(("acl" . ,acl)
868 ("covercache_keep_days" . ,covercache-ttl)
869 ("http" . ,http?)
870 ("http_host" . ,host)
871 ("http_port" . ,port)
872 ("loglevel" . ,log-level)
873 ("lualibs" . ,lualibs)
874 ("mympd_uri" . ,uri)
875 ("scriptacl" . ,script-acl)
876 ("ssl" . ,ssl?)
877 ("ssl_port" . ,ssl-port)
878 ("ssl_cert" . ,ssl-cert)
879 ("ssl_key" . ,ssl-key)
880 ("pin_hash" . ,pin-hash)
881 ("save_caches" . ,save-caches?))))
882 (filter list?
883 (generic-serialize-alist list serialize-field
884 filename-to-field)))))
885
886(define (mympd-shepherd-service config)
887 (match-record config <mympd-configuration>
888 (package shepherd-requirement user work-directory cache-directory
889 log-level log-to)
890 (shepherd-service
891 (documentation "Run the myMPD daemon.")
892 (requirement `(loopback user-processes
893 ,@(if (maybe-value-set? log-to)
894 '()
895 '(syslogd))
896 ,@shepherd-requirement))
897 (provision '(mympd))
898 (start
899 (let ((username (user-account-name user)))
900 (with-imported-modules (source-module-closure
901 '((gnu build activation)))
902 #~(begin
903 (use-modules (gnu build activation))
904
905 (let ((user (getpw #$username)))
906
907 (define (init-directory directory)
908 (unless (file-exists? directory)
909 (mkdir-p/perms directory user #o755)))
910
911 (for-each init-directory
912 '#$(map dirname (filter-map maybe-value
913 (list log-to
914 work-directory
915 cache-directory)))))
916
917 (make-forkexec-constructor
918 `(#$(file-append package "/bin/mympd")
919 "--user" #$username
920 #$@(if (eq? log-to 'syslog) '("--syslog") '())
921 "--workdir" #$work-directory
922 "--cachedir" #$cache-directory)
923 #:environment-variables
924 (list #$(format #f "MYMPD_LOGLEVEL=~a" log-level))
925 #:log-file #$(maybe-value log-to)))))))))
926
927(define (mympd-accounts config)
928 (match-record config <mympd-configuration> (user group)
929 ;; TODO: Deprecation code, to be removed.
930 (let ((user (if (eq? (user-account-group user) %lazy-group)
931 (set-user-group user group)
932 user)))
933 (list user group))))
934
935(define mympd-service-type
936 (service-type
937 (name 'mympd)
938 (extensions
939 (list (service-extension shepherd-root-service-type
940 (compose list mympd-shepherd-service))
941 (service-extension account-service-type
942 mympd-accounts)
943 (service-extension special-files-service-type
944 mympd-serialize-configuration)))
945 (description "Run myMPD, a frontend for MPD (Music Player Daemon).")
946 (default-value (mympd-configuration))))
947
948
949;;;
950;;; Snapcast
951;;;
952
953(define %snapserver-user
954 (user-account
955 (name "snapserver")
956 (group %lazy-group)
957 (system? #t)
958 (comment "Snapcast server user")
959 (home-directory "/var/lib/snapserver")
960 (shell (file-append shadow "/sbin/nologin"))))
961
962(define %snapserver-group
963 (user-group
964 (name "snapserver")
965 (system? #t)))
966
967(define (snapserver-stream-type? value)
968 (memq value '(pipe file process librespot airplay tcp alsa meta)))
969
970(define-maybe/no-serialization file-like)
971
972(define-configuration/no-serialization snapserver-stream
973 (name
974 (string "default")
975 "Name of the stream, as shown by Snapcast clients.")
976
977 (type
978 (snapserver-stream-type 'pipe)
979 "Type of the stream source: one of @code{pipe}, @code{file},
980@code{process}, @code{librespot}, @code{airplay}, @code{tcp}, @code{alsa} or
981@code{meta}.")
982
983 (location
984 (string "/run/snapserver/snapfifo")
985 "Location of the stream source: a file name for @code{pipe}, @code{file}
986and @code{process} streams, a host name for @code{tcp} streams, a device name
987for @code{alsa} streams, and a slash-separated list of stream names for
988@code{meta} streams.")
989
990 (codec
991 maybe-string
992 "Codec to use for this stream, overriding the @code{codec} field of
993@code{snapserver-configuration}.")
994
995 (sampleformat
996 maybe-string
997 "Sample format of this stream, given as
998@code{@var{rate}:@var{bits}:@var{channels}}, overriding the
999@code{sampleformat} field of @code{snapserver-configuration}.")
1000
1001 (chunk-ms
1002 maybe-integer
1003 "Duration, in milliseconds, of the audio chunks read from this source,
1004overriding the @code{chunk-ms} field of @code{snapserver-configuration}.")
1005
1006 (parameters
1007 (alist '())
1008 "Additional source parameters, given as an association list, for example
1009@code{'((\"controlscript\" . \"meta_mpd.py\"))}."))
1010
1011(define (snapserver-stream->uri stream)
1012 (match-record stream <snapserver-stream>
1013 (name type location codec sampleformat chunk-ms parameters)
1014 (let ((query `(("name" . ,name)
1015 ,@(if (maybe-value-set? codec)
1016 `(("codec" . ,codec))
1017 '())
1018 ,@(if (maybe-value-set? sampleformat)
1019 `(("sampleformat" . ,sampleformat))
1020 '())
1021 ,@(if (maybe-value-set? chunk-ms)
1022 `(("chunk_ms" . ,chunk-ms))
1023 '())
1024 ,@parameters)))
1025 (simple-format #f "~A://~A?~A" type location
1026 (string-join
1027 (map (match-lambda
1028 ((key . value)
1029 (simple-format #f "~A=~A" key value)))
1030 query)
1031 "&")))))
1032
1033(define list-of-snapserver-stream?
1034 (list-of snapserver-stream?))
1035
1036(define-configuration/no-serialization snapserver-configuration
1037 (package
1038 (file-like snapcast)
1039 "The Snapcast package to use.")
1040
1041 (user
1042 (user-account %snapserver-user)
1043 "Owner of the @command{snapserver} process.")
1044
1045 (group
1046 (user-group %snapserver-group)
1047 "Owner group of the @command{snapserver} process.")
1048
1049 (shepherd-requirement
1050 (list-of-symbols '())
1051 "This is a list of symbols naming Shepherd services that this service
1052will depend on.")
1053
1054 (log-file
1055 (string "/var/log/snapserver.log")
1056 "File where @command{snapserver} writes its log.")
1057
1058 (log-filter
1059 (string "*:info")
1060 "Log filter, given as @code{@var{tag}:@var{level}} pairs separated by
1061commas, where @var{tag} is @code{*} or a log tag and @var{level} is one of
1062@code{trace}, @code{debug}, @code{info}, @code{notice}, @code{warning},
1063@code{error} or @code{fatal}.")
1064
1065 (data-directory
1066 (string "/var/lib/snapserver")
1067 "Directory where @command{snapserver} stores persistent data, such as
1068client settings.")
1069
1070 (mdns?
1071 (boolean #t)
1072 "Whether to publish the Snapcast services over mDNS. This requires
1073@code{avahi-service-type} (@pxref{Networking Services}).")
1074
1075 (http?
1076 (boolean #t)
1077 "Whether to enable the HTTP JSON-RPC interface, which also serves the
1078Snapweb web interface.")
1079
1080 (http-port
1081 (integer 1780)
1082 "Port the HTTP server listens on.")
1083
1084 (http-bind-address
1085 (string "::")
1086 "Address the HTTP server listens on.")
1087
1088 (doc-root
1089 maybe-file-like
1090 "Directory served by the HTTP server. It defaults to the Snapweb web
1091interface bundled with the @code{package} field.")
1092
1093 (tcp-control?
1094 (boolean #t)
1095 "Whether to enable the TCP JSON-RPC control interface.")
1096
1097 (tcp-control-port
1098 (integer 1705)
1099 "Port the TCP control interface listens on.")
1100
1101 (tcp-streaming?
1102 (boolean #t)
1103 "Whether to enable TCP streaming, which is what Snapcast clients connect
1104to.")
1105
1106 (tcp-streaming-port
1107 (integer 1704)
1108 "Port the TCP streaming interface listens on.")
1109
1110 (streams
1111 (list-of-snapserver-stream (list (snapserver-stream)))
1112 "List of @code{snapserver-stream} records describing the audio sources
1113@command{snapserver} reads from.")
1114
1115 (codec
1116 (string "flac")
1117 "Default codec used to send audio to clients, given as
1118@code{@var{codec}[:@var{options}]} where @var{codec} is one of @code{flac},
1119@code{ogg}, @code{opus} or @code{pcm}.")
1120
1121 (sampleformat
1122 (string "48000:16:2")
1123 "Default sample format of the streams, given as
1124@code{@var{rate}:@var{bits}:@var{channels}}.")
1125
1126 (buffer-ms
1127 (integer 1000)
1128 "End-to-end latency, in milliseconds.")
1129
1130 (chunk-ms
1131 (integer 20)
1132 "Default duration, in milliseconds, of the audio chunks read from the
1133sources.")
1134
1135 (send-to-muted?
1136 (boolean #f)
1137 "Whether to send audio to muted clients.")
1138
1139 (extra-content
1140 maybe-string
1141 "Content appended verbatim to @file{snapserver.conf}, for options that are
1142not covered by the fields above, such as the @code{[ssl]} and
1143@code{[authorization]} sections."))
1144
1145(define (snapserver-config-file config)
1146 (define (boolean->string value)
1147 (if value "1" "0"))
1148
1149 (match-record config <snapserver-configuration>
1150 (package log-filter data-directory mdns?
1151 http? http-port http-bind-address doc-root
1152 tcp-control? tcp-control-port tcp-streaming? tcp-streaming-port
1153 streams codec sampleformat buffer-ms chunk-ms send-to-muted?
1154 extra-content)
1155 (apply mixed-text-file "snapserver.conf"
1156 `("[server]\n"
1157 "datadir = " ,data-directory "\n"
1158 "mdns_enabled = " ,(boolean->string mdns?) "\n"
1159
1160 "\n[http]\n"
1161 "enabled = " ,(boolean->string http?) "\n"
1162 "port = " ,(number->string http-port) "\n"
1163 "bind_to_address = " ,http-bind-address "\n"
1164 "doc_root = " ,(if (maybe-value-set? doc-root)
1165 doc-root
1166 (file-append package
1167 "/share/snapserver/snapweb"))
1168 "\n"
1169
1170 "\n[tcp-control]\n"
1171 "enabled = " ,(boolean->string tcp-control?) "\n"
1172 "port = " ,(number->string tcp-control-port) "\n"
1173
1174 "\n[tcp-streaming]\n"
1175 "enabled = " ,(boolean->string tcp-streaming?) "\n"
1176 "port = " ,(number->string tcp-streaming-port) "\n"
1177
1178 "\n[stream]\n"
1179 ;; The upstream defaults for these two point into /usr/share.
1180 "plugin_dir = " ,(file-append package
1181 "/share/snapserver/plug-ins") "\n"
1182 "sandbox_dir = " ,(file-append package
1183 "/share/snapserver/sandbox") "\n"
1184 ,@(map (lambda (stream)
1185 (string-append "source = "
1186 (snapserver-stream->uri stream) "\n"))
1187 streams)
1188 "codec = " ,codec "\n"
1189 "sampleformat = " ,sampleformat "\n"
1190 "buffer = " ,(number->string buffer-ms) "\n"
1191 "chunk_ms = " ,(number->string chunk-ms) "\n"
1192 "send_to_muted = " ,(boolean->string send-to-muted?) "\n"
1193
1194 "\n[logging]\n"
1195 ;; Log to standard error, which the Shepherd redirects to the
1196 ;; 'log-file' of the service.
1197 "sink = stderr\n"
1198 "filter = " ,log-filter "\n"
1199 ,@(if (maybe-value-set? extra-content)
1200 `("\n" ,extra-content "\n")
1201 '())))))
1202
1203(define (snapserver-shepherd-service config)
1204 (match-record config <snapserver-configuration>
1205 (package user group shepherd-requirement log-file data-directory
1206 mdns? streams)
1207 (let ((config-file (snapserver-config-file config))
1208 (username (user-account-name user))
1209 (groupname (user-group-name group))
1210 ;; 'snapserver' creates the named pipes of its 'pipe' sources, but
1211 ;; not the directories holding them.
1212 (directories
1213 (delete-duplicates
1214 (cons* data-directory (dirname log-file)
1215 (filter-map (lambda (stream)
1216 (and (eq? 'pipe
1217 (snapserver-stream-type
1218 stream))
1219 (dirname
1220 (snapserver-stream-location
1221 stream))))
1222 streams)))))
1223 (shepherd-service
1224 (documentation "Run the Snapcast server.")
1225 (requirement `(user-processes loopback
1226 ,@(if mdns? '(avahi-daemon) '())
1227 ,@shepherd-requirement))
1228 (provision '(snapserver))
1229 (start
1230 (with-imported-modules (source-module-closure
1231 '((gnu build activation)))
1232 #~(begin
1233 (use-modules (gnu build activation))
1234
1235 (let ((user (getpw #$username)))
1236 (for-each (lambda (directory)
1237 (unless (file-exists? directory)
1238 (mkdir-p/perms directory user #o755)))
1239 '#$directories))
1240
1241 (make-forkexec-constructor
1242 (list #$(file-append package "/bin/snapserver")
1243 "--config" #$config-file)
1244 #:user #$username
1245 #:group #$groupname
1246 #:log-file #$log-file))))
1247 (stop #~(make-kill-destructor))
1248 (actions (list (shepherd-configuration-action config-file)))))))
1249
1250(define (snapserver-accounts config)
1251 (match-record config <snapserver-configuration> (user group)
1252 (list (if (eq? (user-account-group user) %lazy-group)
1253 (set-user-group user group)
1254 user)
1255 group)))
1256
1257(define snapserver-service-type
1258 (service-type
1259 (name 'snapserver)
1260 (extensions
1261 (list (service-extension shepherd-root-service-type
1262 (compose list snapserver-shepherd-service))
1263 (service-extension account-service-type
1264 snapserver-accounts)))
1265 (description "Run the Snapcast server, @command{snapserver}, which streams
1266audio to Snapcast clients.")
1267 (default-value (snapserver-configuration))))