gnu/services/sound.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018, 2020 Oleg Pykhalov <go.wigust@gmail.com>
   3 ;;; Copyright © 2020 Liliana Marie Prikler <liliana.prikler@gmail.com>
   4 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
   5 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   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 sound)
  23   #:use-module (gnu services base)
  24   #:use-module (gnu services configuration)
  25   #:use-module (gnu services shepherd)
  26   #:use-module (gnu services)
  27   #:use-module (gnu system pam)
  28   #:use-module (gnu system shadow)
  29   #:use-module (guix diagnostics)
  30   #:use-module (guix gexp)
  31   #:use-module (guix packages)
  32   #:use-module (guix records)
  33   #:use-module (guix store)
  34   #:use-module (guix ui)
  35   #:use-module (gnu packages audio)
  36   #:use-module (gnu packages linux)
  37   #:use-module (gnu packages pulseaudio)
  38   #:use-module (ice-9 match)
  39   #:use-module (srfi srfi-1)
  40   #:export (alsa-configuration
  41             alsa-service-type
  42
  43             pulseaudio-configuration
  44             pulseaudio-service-type
  45
  46             ladspa-configuration
  47             ladspa-service-type))
  48
  49 ;;; Commentary:
  50 ;;;
  51 ;;; Sound services.
  52 ;;;
  53 ;;; Code:
  54
  55 \f
  56 ;;;
  57 ;;; ALSA
  58 ;;;
  59
  60 (define-record-type* <alsa-configuration>
  61   alsa-configuration make-alsa-configuration alsa-configuration?
  62   (alsa-plugins alsa-configuration-alsa-plugins ;file-like
  63                 (default alsa-plugins))
  64   (pulseaudio?   alsa-configuration-pulseaudio? ;boolean
  65                  (default #t))
  66   (extra-options alsa-configuration-extra-options ;string
  67                  (default "")))
  68
  69 (define alsa-config-file
  70   ;; Return the ALSA configuration file.
  71   (match-lambda
  72     (($ <alsa-configuration> alsa-plugins pulseaudio? extra-options)
  73      (apply mixed-text-file "asound.conf"
  74             `("# Generated by 'alsa-service'.\n\n"
  75               ,@(if pulseaudio?
  76                     `("# Use PulseAudio by default
  77 pcm_type.pulse {
  78   lib \"" ,#~(string-append #$alsa-plugins:pulseaudio
  79                             "/lib/alsa-lib/libasound_module_pcm_pulse.so") "\"
  80 }
  81
  82 ctl_type.pulse {
  83   lib \"" ,#~(string-append #$alsa-plugins:pulseaudio
  84                             "/lib/alsa-lib/libasound_module_ctl_pulse.so") "\"
  85 }
  86
  87 pcm.!default {
  88   type pulse
  89   fallback \"sysdefault\"
  90   hint {
  91     show on
  92     description \"Default ALSA Output (currently PulseAudio Sound Server)\"
  93   }
  94 }
  95
  96 ctl.!default {
  97   type pulse
  98   fallback \"sysdefault\"
  99 }\n\n")
 100                     '())
 101               ,extra-options)))))
 102
 103 (define (alsa-etc-service config)
 104   (list `("asound.conf" ,(alsa-config-file config))))
 105
 106 (define alsa-service-type
 107   (service-type
 108    (name 'alsa)
 109    (extensions
 110     (list (service-extension etc-service-type alsa-etc-service)))
 111    (default-value (alsa-configuration))
 112    (description "Configure low-level Linux sound support, ALSA.")))
 113
 114 \f
 115 ;;;
 116 ;;; PulseAudio
 117 ;;;
 118
 119 (define-record-type* <pulseaudio-configuration>
 120   pulseaudio-configuration make-pulseaudio-configuration
 121   pulseaudio-configuration?
 122   (client-conf pulseaudio-configuration-client-conf
 123                (default '()))
 124   (daemon-conf pulseaudio-configuration-daemon-conf
 125                ;; Flat volumes may cause unpleasant experiences to users
 126                ;; when applications inadvertently max out the system volume
 127                ;; (see e.g. <https://bugs.gnu.org/38172>).
 128                (default '((flat-volumes . no))))
 129   (script-file pulseaudio-configuration-script-file
 130                (default (file-append pulseaudio "/etc/pulse/default.pa")))
 131   (extra-script-files pulseaudio-configuration-extra-script-files
 132                       (default '()))
 133   (system-script-file pulseaudio-configuration-system-script-file
 134                       (default
 135                         (file-append pulseaudio "/etc/pulse/system.pa"))))
 136
 137 (define (pulseaudio-conf-entry arg)
 138   (match arg
 139     ((key . value)
 140      (format #f "~a = ~s~%" key value))
 141     ((? string? _)
 142      (string-append arg "\n"))))
 143
 144 (define pulseaudio-environment
 145   (match-lambda
 146     (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file)
 147      ;; These config files kept at a fixed location, so that the following
 148      ;; environment values are stable and do not require the user to reboot to
 149      ;; effect their PulseAudio configuration changes.
 150      '(("PULSE_CONFIG" . "/etc/pulse/daemon.conf")
 151        ("PULSE_CLIENTCONFIG" . "/etc/pulse/client.conf")))))
 152
 153 (define (extra-script-files->file-union extra-script-files)
 154   "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION."
 155
 156   (define (file-like->name file)
 157     (match file
 158       ((? local-file?)
 159        (local-file-name file))
 160       ((? plain-file?)
 161        (plain-file-name file))
 162       ((? computed-file?)
 163        (computed-file-name file))
 164       (_ (leave (G_ "~a is not a local-file, plain-file or \
 165 computed-file object~%") file))))
 166
 167   (define (assert-pulseaudio-script-file-name name)
 168     (unless (string-suffix? ".pa" name)
 169       (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name))
 170     name)
 171
 172   (let ((labels (map (compose assert-pulseaudio-script-file-name
 173                               file-like->name)
 174                      extra-script-files)))
 175     (file-union "default.pa.d" (zip labels extra-script-files))))
 176
 177 (define (append-include-directive script-file)
 178   "Append an include directive to source scripts under /etc/pulse/default.pa.d."
 179   (computed-file "default.pa"
 180                  #~(begin
 181                      (use-modules (ice-9 textual-ports))
 182                      (define script-text
 183                        (call-with-input-file #$script-file get-string-all))
 184                      (call-with-output-file #$output
 185                        (lambda (port)
 186                          (format port (string-append script-text "
 187 ### Added by Guix to include scripts specified in extra-script-files.
 188 .nofail
 189 .include /etc/pulse/default.pa.d~%")))))))
 190
 191 (define pulseaudio-etc
 192   (match-lambda
 193     (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file
 194                                    extra-script-files system-script-file)
 195      `(("pulse"
 196         ,(file-union
 197           "pulse"
 198           `(("default.pa"
 199              ,(if (null? extra-script-files)
 200                   default-script-file
 201                   (append-include-directive default-script-file)))
 202             ("system.pa" ,system-script-file)
 203             ,@(if (null? extra-script-files)
 204                   '()
 205                   `(("default.pa.d" ,(extra-script-files->file-union
 206                                       extra-script-files))))
 207             ,@(if (null? daemon-conf)
 208                   '()
 209                   `(("daemon.conf"
 210                      ,(apply mixed-text-file "daemon.conf"
 211                              "default-script-file = " default-script-file "\n"
 212                              (map pulseaudio-conf-entry daemon-conf)))))
 213             ,@(if (null? client-conf)
 214                   '()
 215                   `(("client.conf"
 216                      ,(apply mixed-text-file "client.conf"
 217                              (map pulseaudio-conf-entry client-conf))))))))))))
 218
 219 (define pulseaudio-service-type
 220   (service-type
 221    (name 'pulseaudio)
 222    (extensions
 223     (list (service-extension session-environment-service-type
 224                              pulseaudio-environment)
 225           (service-extension etc-service-type pulseaudio-etc)
 226           (service-extension udev-service-type (const (list pulseaudio)))))
 227    (default-value (pulseaudio-configuration))
 228    (description "Configure PulseAudio sound support.")))
 229
 230 \f
 231 ;;;
 232 ;;; LADSPA
 233 ;;;
 234
 235 (define-record-type* <ladspa-configuration>
 236   ladspa-configuration make-ladspa-configuration
 237   ladspa-configuration?
 238   (plugins ladspa-plugins (default '())))
 239
 240 (define (ladspa-environment config)
 241   ;; Define this variable in the global environment such that
 242   ;; pulseaudio swh-plugins (and similar LADSPA plugins) work.
 243   `(("LADSPA_PATH" .
 244      (string-join
 245       ',(map (lambda (package) (file-append package "/lib/ladspa"))
 246              (ladspa-plugins config))
 247       ":"))))
 248
 249 (define ladspa-service-type
 250   (service-type
 251    (name 'ladspa)
 252    (extensions
 253     (list (service-extension session-environment-service-type
 254                              ladspa-environment)))
 255    (default-value (ladspa-configuration))
 256    (description "Configure LADSPA plugins.")))
 257
 258 ;;; sound.scm ends here