projects/guix·blob java-team · refs

501 lines · 18.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018, 2020 Oleg Pykhalov <[email protected]>
3;;; Copyright © 2020 Liliana Marie Prikler <[email protected]>
4;;; Copyright © 2020 Marius Bakke <[email protected]>
5;;; Copyright © 2022 Maxim Cournoyer <[email protected]>
6;;; Copyright © 2025 Roman Scherer <[email protected]>
7;;;
8;;; This file is part of GNU Guix.
9;;;
10;;; GNU Guix is free software; you can redistribute it and/or modify it
11;;; under the terms of the GNU General Public License as published by
12;;; the Free Software Foundation; either version 3 of the License, or (at
13;;; your option) any later version.
14;;;
15;;; GNU Guix is distributed in the hope that it will be useful, but
16;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;;; GNU General Public License for more details.
19;;;
20;;; You should have received a copy of the GNU General Public License
21;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22
23(define-module (gnu services sound)
24 #:use-module (gnu services base)
25 #:use-module (gnu services configuration)
26 #:use-module (gnu services shepherd)
27 #:use-module (gnu services)
28 #:use-module (gnu system pam)
29 #:use-module (gnu system shadow)
30 #:use-module (guix diagnostics)
31 #:use-module (guix gexp)
32 #:use-module (guix modules)
33 #:use-module (guix packages)
34 #:use-module (guix records)
35 #:use-module (guix store)
36 #:use-module (guix ui)
37 #:use-module (gnu packages admin)
38 #:use-module (gnu packages audio)
39 #:use-module (gnu packages linux)
40 #:use-module (gnu packages pulseaudio)
41 #:use-module (gnu packages rust-apps)
42 #:use-module (ice-9 match)
43 #:use-module (srfi srfi-1)
44 #:export (alsa-pcm-configuration
45 alsa-pcm-configuration-type
46 alsa-pcm-configuration-hint
47 alsa-pcm-configuration-configuration
48
49 alsa-ctl-configuration
50 alsa-ctl-configuration-type
51 alsa-ctl-configuration-configuration
52
53 alsa-configuration
54 alsa-configuration?
55 alsa-configuration-default-ctl
56 alsa-configuration-default-pcm
57 alsa-configuration-options
58 alsa-service-type
59
60 alsa-persistence-service-type
61
62 pulseaudio-configuration
63 pulseaudio-configuration?
64 pulseaudio-configuration-client-conf
65 pulseaudio-configuration-daemon-conf
66 pulseaudio-configuration-script-file
67 pulseaudio-configuration-extra-script-files
68 pulseaudio-configuration-system-script-file
69 pulseaudio-service-type
70
71 ladspa-configuration
72 ladspa-configuration?
73 ladspa-configuration-plugins
74 ladspa-service-type
75
76 speakersafetyd-configuration
77 speakersafetyd-configuration-blackbox-directory
78 speakersafetyd-configuration-configuration-directory
79 speakersafetyd-configuration-maximum-gain-reduction
80 speakersafetyd-configuration-speakersafetyd
81 speakersafetyd-configuration?
82 speakersafetyd-service-type))
83
84;;; Commentary:
85;;;
86;;; Sound services.
87;;;
88;;; Code:
89
90
91;;;
92;;; ALSA
93;;;
94
95(define-maybe/no-serialization string)
96
97(define-configuration/no-serialization alsa-pcm-configuration
98 (type symbol "The PCM type.")
99 (hint maybe-string "A human-readable description of the PCM.")
100 (configuration
101 list-of-strings
102 "Additional configuration. Each item will be printed on a separate line."))
103
104(define-configuration/no-serialization alsa-ctl-configuration
105 (type symbol "The CTL type.")
106 (configuration
107 list-of-strings
108 "Additional configuration. Each item will be printed on a separate line."))
109
110(define-record-type* <alsa-configuration>
111 alsa-configuration make-alsa-configuration alsa-configuration?
112 (default-pcm alsa-configuration-default-pcm (default #f))
113 (default-ctl alsa-configuration-default-ctl (default #f))
114 (options alsa-configuration-options ; string
115 (default (list))))
116
117(define (serialize-alsa-pcm-configuration config name)
118 (match-record config <alsa-pcm-configuration>
119 (type hint configuration)
120 #~(string-append
121 "pcm." #$name " {\n"
122 " type " #$(symbol->string type) "\n"
123 #$(if hint
124 (string-append " hint { show on; description \"" hint "\" }\n")
125 "")
126 #$(if (null? configuration) "" " ")
127 #$(string-join configuration "\n ")
128 "\n}")))
129
130(define (serialize-alsa-ctl-configuration config name)
131 (match-record config <alsa-ctl-configuration>
132 (type configuration)
133 #~(string-append
134 "ctl." #$name " {\n"
135 " type " #$(symbol->string type) "\n"
136 #$(if (null? configuration) "" " ")
137 #$(string-join configuration "\n ")
138 "\n}")))
139
140(define alsa-config-file
141 ;; Return the ALSA configuration file.
142 (match-lambda
143 (($ <alsa-configuration> default-pcm default-ctl options)
144 (mixed-text-file
145 "asound.conf"
146 #~(string-join
147 (list
148 "# Generated by 'alsa-service'"
149 #$@options
150 #$@(if default-pcm
151 (list
152 (serialize-alsa-pcm-configuration default-pcm "!default"))
153 '())
154 #$@(if default-ctl
155 (list
156 (serialize-alsa-ctl-configuration default-ctl "!default"))
157 '()))
158 "\n")))))
159
160(define (alsa-etc-service config)
161 (list `("asound.conf" ,(alsa-config-file config))))
162
163(define alsa-service-type
164 (service-type
165 (name 'alsa)
166 (extensions
167 (list (service-extension etc-service-type alsa-etc-service)))
168 (compose concatenate)
169 (extend (lambda (config extensions)
170 (let* ((configs (cons config extensions))
171 (options (append-map (lambda (cfg)
172 (alsa-configuration-options cfg))
173 configs))
174 (default-pcm (any (lambda (cfg)
175 (alsa-configuration-default-pcm cfg))
176 (reverse configs)))
177 (default-ctl (any (lambda (cfg)
178 (alsa-configuration-default-ctl cfg))
179 (reverse configs))))
180 (alsa-configuration
181 (default-pcm default-pcm)
182 (default-ctl default-ctl)
183 (options options)))))
184 (default-value (alsa-configuration))
185 (description "Configure low-level Linux sound support, ALSA.")))
186
187
188;;;
189;;; ALSA Persistence
190;;;
191
192(define %alsa-persistence-activation
193 #~(begin
194 (use-modules (guix build utils))
195 (mkdir-p "/var/lib/alsa")))
196
197(define (alsa-persistence-shepherd-service alsactl-args)
198 (list (shepherd-service
199 (provision '(alsa-persistence))
200 (requirement '(user-processes))
201 (documentation "Store and restore ALSA volume levels.")
202 ;; Ideally, we would declare this services to be one-shot as it
203 ;; doesn't start a long-running daemon. Unfortunately, the stop
204 ;; action cannot be triggered for one-shot services, thus it is
205 ;; unsuitable here and we just prevent respawning of the service.
206 (respawn? #f)
207 (start #~(lambda _
208 (if (file-exists? "/var/lib/alsa/asound.state")
209 (invoke
210 #$(file-append alsa-utils "/sbin/alsactl")
211 "restore"
212 #$@alsactl-args)
213 #t)))
214 (stop #~(lambda _
215 (invoke
216 #$(file-append alsa-utils "/sbin/alsactl")
217 "store"
218 #$@alsactl-args))))))
219
220(define alsa-persistence-service-type
221 (service-type
222 (name 'alsa-persistence)
223 (extensions
224 (list (service-extension shepherd-root-service-type
225 alsa-persistence-shepherd-service)
226 (service-extension activation-service-type
227 (const %alsa-persistence-activation))))
228 (description
229 "One-shot service which stores and restores the ALSA volume
230level using the @command{alsactl} command.")
231 (default-value '())))
232
233
234;;;
235;;; PulseAudio
236;;;
237
238(define-record-type* <pulseaudio-configuration>
239 pulseaudio-configuration make-pulseaudio-configuration
240 pulseaudio-configuration?
241 (client-conf pulseaudio-configuration-client-conf
242 (default '()))
243 (daemon-conf pulseaudio-configuration-daemon-conf
244 ;; Flat volumes may cause unpleasant experiences to users
245 ;; when applications inadvertently max out the system volume
246 ;; (see e.g. <https://bugs.gnu.org/38172>).
247 (default '((flat-volumes . no))))
248 (script-file pulseaudio-configuration-script-file
249 (default (file-append pulseaudio "/etc/pulse/default.pa")))
250 (extra-script-files pulseaudio-configuration-extra-script-files
251 (default '()))
252 (system-script-file pulseaudio-configuration-system-script-file
253 (default
254 (file-append pulseaudio "/etc/pulse/system.pa")))
255 (alsa-lib pulseaudio-alsa-lib
256 (default #~(string-append #$alsa-plugins:pulseaudio
257 "/lib/alsa-lib"))))
258
259(define (pulseaudio-conf-entry arg)
260 (match arg
261 ((key . value)
262 (format #f "~a = ~s~%" key value))
263 ((? string? _)
264 (string-append arg "\n"))))
265
266(define pulseaudio-environment
267 (match-lambda
268 (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file)
269 ;; These config files kept at a fixed location, so that the following
270 ;; environment values are stable and do not require the user to reboot to
271 ;; effect their PulseAudio configuration changes.
272 '(("PULSE_CONFIG" . "/etc/pulse/daemon.conf")
273 ("PULSE_CLIENTCONFIG" . "/etc/pulse/client.conf")))))
274
275(define (extra-script-files->file-union extra-script-files)
276 "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION."
277
278 (define (file-like->name file)
279 (match file
280 ((? local-file?)
281 (local-file-name file))
282 ((? plain-file?)
283 (plain-file-name file))
284 ((? computed-file?)
285 (computed-file-name file))
286 (_ (leave (G_ "~a is not a local-file, plain-file or \
287computed-file object~%") file))))
288
289 (define (assert-pulseaudio-script-file-name name)
290 (unless (string-suffix? ".pa" name)
291 (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name))
292 name)
293
294 (let ((labels (map (compose assert-pulseaudio-script-file-name
295 file-like->name)
296 extra-script-files)))
297 (file-union "default.pa.d" (zip labels extra-script-files))))
298
299(define (append-include-directive script-file)
300 "Append an include directive to source scripts under /etc/pulse/default.pa.d."
301 (computed-file "default.pa"
302 #~(begin
303 (use-modules (ice-9 textual-ports))
304 (define script-text
305 (call-with-input-file #$script-file get-string-all))
306 (call-with-output-file #$output
307 (lambda (port)
308 (format port (string-append script-text "
309### Added by Guix to include scripts specified in extra-script-files.
310.nofail
311.include /etc/pulse/default.pa.d~%")))))))
312
313(define pulseaudio-etc
314 (match-record-lambda <pulseaudio-configuration>
315 ;; Note: extra space for Emacs alignment.
316 ( client-conf daemon-conf
317 script-file extra-script-files system-script-file )
318 `(("pulse"
319 ,(file-union
320 "pulse"
321 `(("default.pa"
322 ,(if (null? extra-script-files)
323 script-file
324 (append-include-directive script-file)))
325 ("system.pa" ,system-script-file)
326 ,@(if (null? extra-script-files)
327 '()
328 `(("default.pa.d" ,(extra-script-files->file-union
329 extra-script-files))))
330 ("daemon.conf"
331 ,(apply mixed-text-file "daemon.conf"
332 "default-script-file = /etc/pulse/default.pa\n"
333 (map pulseaudio-conf-entry daemon-conf)))
334 ("client.conf"
335 ,(apply mixed-text-file "client.conf"
336 (map pulseaudio-conf-entry client-conf)))))))))
337
338(define pulseaudio-alsa-configuration
339 (match-record-lambda <pulseaudio-configuration>
340 (alsa-lib)
341 (list
342 (alsa-configuration
343 (default-pcm
344 (alsa-pcm-configuration
345 (type 'pulse)
346 (hint "Default ALSA Output (currently PulseAudio Sound Server)")
347 (configuration (list "fallback \"sysdefault\""))))
348 (default-ctl
349 (alsa-ctl-configuration
350 (type 'pulse)
351 (configuration (list "fallback \"sysdefault\""))))
352 (options
353 (list
354 #~(string-append "pcm_type.pulse {
355 lib \"" #$alsa-lib "/libasound_module_pcm_pulse.so\"
356}")
357 #~(string-append "ctl_type.pulse {
358 lib \"" #$alsa-lib "/libasound_module_ctl_pulse.so\"
359}")))))))
360
361(define pulseaudio-service-type
362 (service-type
363 (name 'pulseaudio)
364 (extensions
365 (list (service-extension alsa-service-type
366 pulseaudio-alsa-configuration)
367 (service-extension session-environment-service-type
368 pulseaudio-environment)
369 (service-extension etc-service-type pulseaudio-etc)
370 (service-extension udev-service-type (const (list pulseaudio)))))
371 (default-value (pulseaudio-configuration))
372 (description "Configure PulseAudio sound support.")))
373
374
375;;;
376;;; LADSPA
377;;;
378
379(define-record-type* <ladspa-configuration>
380 ladspa-configuration make-ladspa-configuration
381 ladspa-configuration?
382 (plugins ladspa-configuration-plugins (default '())))
383
384(define (ladspa-environment config)
385 ;; Define this variable in the global environment such that
386 ;; pulseaudio swh-plugins (and similar LADSPA plugins) work.
387 `(("LADSPA_PATH" .
388 (string-join
389 ',(map (lambda (package) (file-append package "/lib/ladspa"))
390 (ladspa-configuration-plugins config))
391 ":"))))
392
393(define ladspa-service-type
394 (service-type
395 (name 'ladspa)
396 (extensions
397 (list (service-extension session-environment-service-type
398 ladspa-environment)))
399 (default-value (ladspa-configuration))
400 (description "Configure LADSPA plugins.")))
401
402
403;;;
404;;; Speaker Safety Daemon.
405;;;
406
407(define-configuration/no-serialization speakersafetyd-configuration
408 (blackbox-directory
409 (string "/var/lib/speakersafetyd/blackbox")
410 "The directory to which blackbox files are written when the speakers are
411getting too hot. The blackbox files contain audio and debug information which
412the developers of @code{speakersafetyd} might ask for when reporting bugs.")
413 (configuration-directory
414 (file-like (file-append speakersafetyd "/share/speakersafetyd"))
415 "The base directory as a G-expression (@pxref{G-Expressions}) that contains
416the configuration files of the speaker models.")
417 (group
418 (string "speakersafetyd")
419 "The group to run the Speaker Safety Daemon as.")
420 (log-file
421 (string "/var/log/speakersafetyd.log")
422 "The file name to the Speaker Safety Daemon log file.")
423 (maximum-gain-reduction
424 (integer 7)
425 "Maximum gain reduction before panicking, useful for debugging.")
426 (speakersafetyd
427 (file-like speakersafetyd)
428 "The Speaker Safety Daemon package to use.")
429 (user
430 (string "speakersafetyd")
431 "The user to run the Speaker Safety Daemon as."))
432
433(define speakersafetyd-accounts
434 (match-record-lambda <speakersafetyd-configuration>
435 (group user)
436 (list (user-group
437 (name group)
438 (system? #t))
439 (user-account
440 (name user)
441 (group group)
442 (system? #t)
443 (home-directory "/var/empty")
444 (shell (file-append shadow "/sbin/nologin"))
445 (supplementary-groups '("audio"))))))
446
447(define speakersafetyd-activation
448 (match-record-lambda <speakersafetyd-configuration>
449 (blackbox-directory group user)
450 (with-imported-modules (source-module-closure '((gnu build activation)))
451 #~(begin
452 (use-modules (gnu build activation))
453 (let ((user (getpwnam #$user)))
454 (mkdir-p/perms "/run/speakersafetyd" user #o755)
455 (mkdir-p/perms "/var/lib/speakersafetyd" user #o755)
456 ;; Blackbox files contain audio recordings and might be sensitive
457 ;; information
458 (mkdir-p/perms #$blackbox-directory user #o700))))))
459
460(define speakersafetyd-shepherd-service
461 (match-record-lambda <speakersafetyd-configuration>
462 ( blackbox-directory configuration-directory group log-file
463 maximum-gain-reduction speakersafetyd user)
464 (shepherd-service
465 (documentation "Run the speaker safety daemon")
466 (provision '(speakersafetyd))
467 (requirement '(user-processes udev))
468 (start #~(make-forkexec-constructor
469 (list #$(file-append speakersafetyd "/bin/speakersafetyd")
470 "--config-path" #$configuration-directory
471 "--blackbox-path" #$blackbox-directory
472 "--max-reduction" (number->string #$maximum-gain-reduction))
473 #:group #$group
474 #:log-file #$log-file
475 #:supplementary-groups '("audio")
476 #:user #$user))
477 (stop #~(make-kill-destructor)))))
478
479(define speakersafetyd-service-type
480 (service-type
481 (name 'speakersafetyd)
482 (description "Run @command{speakersafetyd}, a user space daemon that
483implements an analogue of the Texas Instruments Smart Amp speaker protection
484model. It can be used to protect the speakers on Apple Silicon devices.")
485 (extensions
486 (list (service-extension
487 shepherd-root-service-type
488 (compose list speakersafetyd-shepherd-service))
489 (service-extension
490 udev-service-type
491 (compose list speakersafetyd-configuration-speakersafetyd))
492 (service-extension
493 profile-service-type
494 (compose list speakersafetyd-configuration-speakersafetyd))
495 (service-extension account-service-type
496 speakersafetyd-accounts)
497 (service-extension activation-service-type
498 speakersafetyd-activation)))
499 (default-value (speakersafetyd-configuration))))
500
501;;; sound.scm ends here