| 1 | |
| 2 | |
| 3 | |
| 4 | |
| 5 | |
| 6 | |
| 7 | |
| 8 | |
| 9 | |
| 10 | |
| 11 | |
| 12 | |
| 13 | |
| 14 | |
| 15 | |
| 16 | |
| 17 | |
| 18 | |
| 19 | |
| 20 | |
| 21 | |
| 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 | pulseaudio-configuration
|
| 61 | pulseaudio-configuration?
|
| 62 | pulseaudio-configuration-client-conf
|
| 63 | pulseaudio-configuration-daemon-conf
|
| 64 | pulseaudio-configuration-script-file
|
| 65 | pulseaudio-configuration-extra-script-files
|
| 66 | pulseaudio-configuration-system-script-file
|
| 67 | pulseaudio-service-type
|
| 68 |
|
| 69 | ladspa-configuration
|
| 70 | ladspa-configuration?
|
| 71 | ladspa-configuration-plugins
|
| 72 | ladspa-service-type
|
| 73 |
|
| 74 | speakersafetyd-configuration
|
| 75 | speakersafetyd-configuration-blackbox-directory
|
| 76 | speakersafetyd-configuration-configuration-directory
|
| 77 | speakersafetyd-configuration-maximum-gain-reduction
|
| 78 | speakersafetyd-configuration-speakersafetyd
|
| 79 | speakersafetyd-configuration?
|
| 80 | speakersafetyd-service-type))
|
| 81 |
|
| 82 | |
| 83 | |
| 84 | |
| 85 | |
| 86 | |
| 87 |
|
| 88 |
|
| 89 | |
| 90 | |
| 91 | |
| 92 |
|
| 93 | (define-maybe/no-serialization string)
|
| 94 |
|
| 95 | (define-configuration/no-serialization alsa-pcm-configuration
|
| 96 | (type symbol "The PCM type.")
|
| 97 | (hint maybe-string "A human-readable description of the PCM.")
|
| 98 | (configuration
|
| 99 | list-of-strings
|
| 100 | "Additional configuration. Each item will be printed on a separate line."))
|
| 101 |
|
| 102 | (define-configuration/no-serialization alsa-ctl-configuration
|
| 103 | (type symbol "The CTL type.")
|
| 104 | (configuration
|
| 105 | list-of-strings
|
| 106 | "Additional configuration. Each item will be printed on a separate line."))
|
| 107 |
|
| 108 | (define-record-type* <alsa-configuration>
|
| 109 | alsa-configuration make-alsa-configuration alsa-configuration?
|
| 110 | (default-pcm alsa-configuration-default-pcm (default #f))
|
| 111 | (default-ctl alsa-configuration-default-ctl (default #f))
|
| 112 | (options alsa-configuration-options |
| 113 | (default (list))))
|
| 114 |
|
| 115 | (define (serialize-alsa-pcm-configuration config name)
|
| 116 | (match-record config <alsa-pcm-configuration>
|
| 117 | (type hint configuration)
|
| 118 | #~(string-append
|
| 119 | "pcm." #$name " {\n"
|
| 120 | " type " #$(symbol->string type) "\n"
|
| 121 | #$(if hint
|
| 122 | (string-append " hint { show on; description \"" hint "\" }\n")
|
| 123 | "")
|
| 124 | #$(if (null? configuration) "" " ")
|
| 125 | #$(string-join configuration "\n ")
|
| 126 | "\n}")))
|
| 127 |
|
| 128 | (define (serialize-alsa-ctl-configuration config name)
|
| 129 | (match-record config <alsa-ctl-configuration>
|
| 130 | (type configuration)
|
| 131 | #~(string-append
|
| 132 | "ctl." #$name " {\n"
|
| 133 | " type " #$(symbol->string type) "\n"
|
| 134 | #$(if (null? configuration) "" " ")
|
| 135 | #$(string-join configuration "\n ")
|
| 136 | "\n}")))
|
| 137 |
|
| 138 | (define alsa-config-file
|
| 139 | |
| 140 | (match-lambda
|
| 141 | (($ <alsa-configuration> default-pcm default-ctl options)
|
| 142 | (mixed-text-file
|
| 143 | "asound.conf"
|
| 144 | #~(string-join
|
| 145 | (list
|
| 146 | "# Generated by 'alsa-service'"
|
| 147 | #$@options
|
| 148 | #$@(if default-pcm
|
| 149 | (list
|
| 150 | (serialize-alsa-pcm-configuration default-pcm "!default"))
|
| 151 | '())
|
| 152 | #$@(if default-ctl
|
| 153 | (list
|
| 154 | (serialize-alsa-ctl-configuration default-ctl "!default"))
|
| 155 | '()))
|
| 156 | "\n")))))
|
| 157 |
|
| 158 | (define (alsa-etc-service config)
|
| 159 | (list `("asound.conf" ,(alsa-config-file config))))
|
| 160 |
|
| 161 | (define alsa-service-type
|
| 162 | (service-type
|
| 163 | (name 'alsa)
|
| 164 | (extensions
|
| 165 | (list (service-extension etc-service-type alsa-etc-service)))
|
| 166 | (compose concatenate)
|
| 167 | (extend (lambda (config extensions)
|
| 168 | (let* ((configs (cons config extensions))
|
| 169 | (options (append-map (lambda (cfg)
|
| 170 | (alsa-configuration-options cfg))
|
| 171 | configs))
|
| 172 | (default-pcm (any (lambda (cfg)
|
| 173 | (alsa-configuration-default-pcm cfg))
|
| 174 | (reverse configs)))
|
| 175 | (default-ctl (any (lambda (cfg)
|
| 176 | (alsa-configuration-default-ctl cfg))
|
| 177 | (reverse configs))))
|
| 178 | (alsa-configuration
|
| 179 | (default-pcm default-pcm)
|
| 180 | (default-ctl default-ctl)
|
| 181 | (options options)))))
|
| 182 | (default-value (alsa-configuration))
|
| 183 | (description "Configure low-level Linux sound support, ALSA.")))
|
| 184 |
|
| 185 |
|
| 186 | |
| 187 | |
| 188 | |
| 189 |
|
| 190 | (define-record-type* <pulseaudio-configuration>
|
| 191 | pulseaudio-configuration make-pulseaudio-configuration
|
| 192 | pulseaudio-configuration?
|
| 193 | (client-conf pulseaudio-configuration-client-conf
|
| 194 | (default '()))
|
| 195 | (daemon-conf pulseaudio-configuration-daemon-conf
|
| 196 | |
| 197 | |
| 198 | |
| 199 | (default '((flat-volumes . no))))
|
| 200 | (script-file pulseaudio-configuration-script-file
|
| 201 | (default (file-append pulseaudio "/etc/pulse/default.pa")))
|
| 202 | (extra-script-files pulseaudio-configuration-extra-script-files
|
| 203 | (default '()))
|
| 204 | (system-script-file pulseaudio-configuration-system-script-file
|
| 205 | (default
|
| 206 | (file-append pulseaudio "/etc/pulse/system.pa")))
|
| 207 | (alsa-lib pulseaudio-alsa-lib
|
| 208 | (default #~(string-append #$alsa-plugins:pulseaudio
|
| 209 | "/lib/alsa-lib"))))
|
| 210 |
|
| 211 | (define (pulseaudio-conf-entry arg)
|
| 212 | (match arg
|
| 213 | ((key . value)
|
| 214 | (format #f "~a = ~s~%" key value))
|
| 215 | ((? string? _)
|
| 216 | (string-append arg "\n"))))
|
| 217 |
|
| 218 | (define pulseaudio-environment
|
| 219 | (match-lambda
|
| 220 | (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file)
|
| 221 | |
| 222 | |
| 223 | |
| 224 | '(("PULSE_CONFIG" . "/etc/pulse/daemon.conf")
|
| 225 | ("PULSE_CLIENTCONFIG" . "/etc/pulse/client.conf")))))
|
| 226 |
|
| 227 | (define (extra-script-files->file-union extra-script-files)
|
| 228 | "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION."
|
| 229 |
|
| 230 | (define (file-like->name file)
|
| 231 | (match file
|
| 232 | ((? local-file?)
|
| 233 | (local-file-name file))
|
| 234 | ((? plain-file?)
|
| 235 | (plain-file-name file))
|
| 236 | ((? computed-file?)
|
| 237 | (computed-file-name file))
|
| 238 | (_ (leave (G_ "~a is not a local-file, plain-file or \
|
| 239 | computed-file object~%") file))))
|
| 240 |
|
| 241 | (define (assert-pulseaudio-script-file-name name)
|
| 242 | (unless (string-suffix? ".pa" name)
|
| 243 | (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name))
|
| 244 | name)
|
| 245 |
|
| 246 | (let ((labels (map (compose assert-pulseaudio-script-file-name
|
| 247 | file-like->name)
|
| 248 | extra-script-files)))
|
| 249 | (file-union "default.pa.d" (zip labels extra-script-files))))
|
| 250 |
|
| 251 | (define (append-include-directive script-file)
|
| 252 | "Append an include directive to source scripts under /etc/pulse/default.pa.d."
|
| 253 | (computed-file "default.pa"
|
| 254 | #~(begin
|
| 255 | (use-modules (ice-9 textual-ports))
|
| 256 | (define script-text
|
| 257 | (call-with-input-file #$script-file get-string-all))
|
| 258 | (call-with-output-file #$output
|
| 259 | (lambda (port)
|
| 260 | (format port (string-append script-text "
|
| 261 | ### Added by Guix to include scripts specified in extra-script-files.
|
| 262 | .nofail
|
| 263 | .include /etc/pulse/default.pa.d~%")))))))
|
| 264 |
|
| 265 | (define pulseaudio-etc
|
| 266 | (match-record-lambda <pulseaudio-configuration>
|
| 267 | |
| 268 | ( client-conf daemon-conf
|
| 269 | script-file extra-script-files system-script-file )
|
| 270 | `(("pulse"
|
| 271 | ,(file-union
|
| 272 | "pulse"
|
| 273 | `(("default.pa"
|
| 274 | ,(if (null? extra-script-files)
|
| 275 | script-file
|
| 276 | (append-include-directive script-file)))
|
| 277 | ("system.pa" ,system-script-file)
|
| 278 | ,@(if (null? extra-script-files)
|
| 279 | '()
|
| 280 | `(("default.pa.d" ,(extra-script-files->file-union
|
| 281 | extra-script-files))))
|
| 282 | ("daemon.conf"
|
| 283 | ,(apply mixed-text-file "daemon.conf"
|
| 284 | "default-script-file = /etc/pulse/default.pa\n"
|
| 285 | (map pulseaudio-conf-entry daemon-conf)))
|
| 286 | ("client.conf"
|
| 287 | ,(apply mixed-text-file "client.conf"
|
| 288 | (map pulseaudio-conf-entry client-conf)))))))))
|
| 289 |
|
| 290 | (define pulseaudio-alsa-configuration
|
| 291 | (match-record-lambda <pulseaudio-configuration>
|
| 292 | (alsa-lib)
|
| 293 | (list
|
| 294 | (alsa-configuration
|
| 295 | (default-pcm
|
| 296 | (alsa-pcm-configuration
|
| 297 | (type 'pulse)
|
| 298 | (hint "Default ALSA Output (currently PulseAudio Sound Server)")
|
| 299 | (configuration (list "fallback \"sysdefault\""))))
|
| 300 | (default-ctl
|
| 301 | (alsa-ctl-configuration
|
| 302 | (type 'pulse)
|
| 303 | (configuration (list "fallback \"sysdefault\""))))
|
| 304 | (options
|
| 305 | (list
|
| 306 | #~(string-append "pcm_type.pulse {
|
| 307 | lib \"" #$alsa-lib "/libasound_module_pcm_pulse.so\"
|
| 308 | }")
|
| 309 | #~(string-append "ctl_type.pulse {
|
| 310 | lib \"" #$alsa-lib "/libasound_module_ctl_pulse.so\"
|
| 311 | }")))))))
|
| 312 |
|
| 313 | (define pulseaudio-service-type
|
| 314 | (service-type
|
| 315 | (name 'pulseaudio)
|
| 316 | (extensions
|
| 317 | (list (service-extension alsa-service-type
|
| 318 | pulseaudio-alsa-configuration)
|
| 319 | (service-extension session-environment-service-type
|
| 320 | pulseaudio-environment)
|
| 321 | (service-extension etc-service-type pulseaudio-etc)
|
| 322 | (service-extension udev-service-type (const (list pulseaudio)))))
|
| 323 | (default-value (pulseaudio-configuration))
|
| 324 | (description "Configure PulseAudio sound support.")))
|
| 325 |
|
| 326 |
|
| 327 | |
| 328 | |
| 329 | |
| 330 |
|
| 331 | (define-record-type* <ladspa-configuration>
|
| 332 | ladspa-configuration make-ladspa-configuration
|
| 333 | ladspa-configuration?
|
| 334 | (plugins ladspa-configuration-plugins (default '())))
|
| 335 |
|
| 336 | (define (ladspa-environment config)
|
| 337 | |
| 338 | |
| 339 | `(("LADSPA_PATH" .
|
| 340 | (string-join
|
| 341 | ',(map (lambda (package) (file-append package "/lib/ladspa"))
|
| 342 | (ladspa-configuration-plugins config))
|
| 343 | ":"))))
|
| 344 |
|
| 345 | (define ladspa-service-type
|
| 346 | (service-type
|
| 347 | (name 'ladspa)
|
| 348 | (extensions
|
| 349 | (list (service-extension session-environment-service-type
|
| 350 | ladspa-environment)))
|
| 351 | (default-value (ladspa-configuration))
|
| 352 | (description "Configure LADSPA plugins.")))
|
| 353 |
|
| 354 |
|
| 355 | |
| 356 | |
| 357 | |
| 358 |
|
| 359 | (define-configuration/no-serialization speakersafetyd-configuration
|
| 360 | (blackbox-directory
|
| 361 | (string "/var/lib/speakersafetyd/blackbox")
|
| 362 | "The directory to which blackbox files are written when the speakers are
|
| 363 | getting too hot. The blackbox files contain audio and debug information which
|
| 364 | the developers of @code{speakersafetyd} might ask for when reporting bugs.")
|
| 365 | (configuration-directory
|
| 366 | (file-like (file-append speakersafetyd "/share/speakersafetyd"))
|
| 367 | "The base directory as a G-expression (@pxref{G-Expressions}) that contains
|
| 368 | the configuration files of the speaker models.")
|
| 369 | (group
|
| 370 | (string "speakersafetyd")
|
| 371 | "The group to run the Speaker Safety Daemon as.")
|
| 372 | (log-file
|
| 373 | (string "/var/log/speakersafetyd.log")
|
| 374 | "The file name to the Speaker Safety Daemon log file.")
|
| 375 | (maximum-gain-reduction
|
| 376 | (integer 7)
|
| 377 | "Maximum gain reduction before panicking, useful for debugging.")
|
| 378 | (speakersafetyd
|
| 379 | (file-like speakersafetyd)
|
| 380 | "The Speaker Safety Daemon package to use.")
|
| 381 | (user
|
| 382 | (string "speakersafetyd")
|
| 383 | "The user to run the Speaker Safety Daemon as."))
|
| 384 |
|
| 385 | (define speakersafetyd-accounts
|
| 386 | (match-record-lambda <speakersafetyd-configuration>
|
| 387 | (group user)
|
| 388 | (list (user-group
|
| 389 | (name group)
|
| 390 | (system? #t))
|
| 391 | (user-account
|
| 392 | (name user)
|
| 393 | (group group)
|
| 394 | (system? #t)
|
| 395 | (home-directory "/var/empty")
|
| 396 | (shell (file-append shadow "/sbin/nologin"))
|
| 397 | (supplementary-groups '("audio"))))))
|
| 398 |
|
| 399 | (define speakersafetyd-activation
|
| 400 | (match-record-lambda <speakersafetyd-configuration>
|
| 401 | (blackbox-directory group user)
|
| 402 | (with-imported-modules (source-module-closure '((gnu build activation)))
|
| 403 | #~(begin
|
| 404 | (use-modules (gnu build activation))
|
| 405 | (let ((user (getpwnam #$user)))
|
| 406 | (mkdir-p/perms "/run/speakersafetyd" user #o755)
|
| 407 | (mkdir-p/perms "/var/lib/speakersafetyd" user #o755)
|
| 408 | |
| 409 | |
| 410 | (mkdir-p/perms #$blackbox-directory user #o700))))))
|
| 411 |
|
| 412 | (define speakersafetyd-shepherd-service
|
| 413 | (match-record-lambda <speakersafetyd-configuration>
|
| 414 | ( blackbox-directory configuration-directory group log-file
|
| 415 | maximum-gain-reduction speakersafetyd user)
|
| 416 | (shepherd-service
|
| 417 | (documentation "Run the speaker safety daemon")
|
| 418 | (provision '(speakersafetyd))
|
| 419 | (requirement '(user-processes udev))
|
| 420 | (start #~(make-forkexec-constructor
|
| 421 | (list #$(file-append speakersafetyd "/bin/speakersafetyd")
|
| 422 | "--config-path" #$configuration-directory
|
| 423 | "--blackbox-path" #$blackbox-directory
|
| 424 | "--max-reduction" (number->string #$maximum-gain-reduction))
|
| 425 | #:group #$group
|
| 426 | #:log-file #$log-file
|
| 427 | #:supplementary-groups '("audio")
|
| 428 | #:user #$user))
|
| 429 | (stop #~(make-kill-destructor)))))
|
| 430 |
|
| 431 | (define speakersafetyd-service-type
|
| 432 | (service-type
|
| 433 | (name 'speakersafetyd)
|
| 434 | (description "Run @command{speakersafetyd}, a user space daemon that
|
| 435 | implements an analogue of the Texas Instruments Smart Amp speaker protection
|
| 436 | model. It can be used to protect the speakers on Apple Silicon devices.")
|
| 437 | (extensions
|
| 438 | (list (service-extension
|
| 439 | shepherd-root-service-type
|
| 440 | (compose list speakersafetyd-shepherd-service))
|
| 441 | (service-extension
|
| 442 | udev-service-type
|
| 443 | (compose list speakersafetyd-configuration-speakersafetyd))
|
| 444 | (service-extension
|
| 445 | profile-service-type
|
| 446 | (compose list speakersafetyd-configuration-speakersafetyd))
|
| 447 | (service-extension account-service-type
|
| 448 | speakersafetyd-accounts)
|
| 449 | (service-extension activation-service-type
|
| 450 | speakersafetyd-activation)))
|
| 451 | (default-value (speakersafetyd-configuration))))
|
| 452 |
|
| 453 | |