projects/guix·blob ruby-team · refs

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