;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013 David Thompson ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2014 Mark H Weaver ;;; Copyright © 2015 Paul van der Walt ;;; Copyright © 2015, 2016, 2017, 2019 Efraim Flashner ;;; Copyright © 2017, 2018, 2019 Marius Bakke ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2018 Leo Famulari ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Liliana Marie Prikler <liliana.prikler@gmail.com>
;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services sound)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services)
  #:use-module (gnu system pam)
  #:use-module (gnu system shadow)
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix ui)
  #:use-module (gnu packages audio)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages pulseaudio)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (alsa-configuration
            alsa-configuration?
            alsa-configuration-alsa-plugins
            alsa-configuration-pulseaudio?
            alsa-configuration-extra-options
            alsa-service-type

            pulseaudio-configuration
            pulseaudio-configuration?
            pulseaudio-configuration-client-conf
            pulseaudio-configuration-daemon-conf
            pulseaudio-configuration-script-file
            pulseaudio-configuration-extra-script-files
            pulseaudio-configuration-system-script-file
            pulseaudio-service-type

            ladspa-configuration
            ladspa-configuration?
            ladspa-configuration-plugins
            ladspa-service-type))

;;; Commentary:
;;;
;;; Sound services.
;;;
;;; Code:


;;;
;;; ALSA
;;;

(define-record-type* <alsa-configuration>
  alsa-configuration make-alsa-configuration alsa-configuration?
  (alsa-plugins alsa-configuration-alsa-plugins ;file-like
                (default alsa-plugins))
  (pulseaudio?   alsa-configuration-pulseaudio? ;boolean
                 (default #t))
  (extra-options alsa-configuration-extra-options ;string
                 (default "")))

(define alsa-config-file
  ;; Return the ALSA configuration file.
  (match-lambda
    (($ <alsa-configuration> alsa-plugins pulseaudio? extra-options)
     (apply mixed-text-file "asound.conf"
            `("# Generated by 'alsa-service'.\n\n"
              ,@(if pulseaudio?
                    `("# Use PulseAudio by default
pcm_type.pulse {
  lib \"" ,#~(string-append #$alsa-plugins:pulseaudio
                            "/lib/alsa-lib/libasound_module_pcm_pulse.so") "\"
}

ctl_type.pulse {
  lib \"" ,#~(string-append #$alsa-plugins:pulseaudio
                            "/lib/alsa-lib/libasound_module_ctl_pulse.so") "\"
}

pcm.!default {
  type pulse
  fallback \"sysdefault\"
  hint {
    show on
    description \"Default ALSA Output (currently PulseAudio Sound Server)\"
  }
}

ctl.!default {
  type pulse
  fallback \"sysdefault\"
}\n\n")
                    '())
              ,extra-options)))))

(define (alsa-etc-service config)
  (list `("asound.conf" ,(alsa-config-file config))))

(define alsa-service-type
  (service-type
   (name 'alsa)
   (extensions
    (list (service-extension etc-service-type alsa-etc-service)))
   (default-value (alsa-configuration))
   (description "Configure low-level Linux sound support, ALSA.")))


;;;
;;; PulseAudio
;;;

(define-record-type* <pulseaudio-configuration>
  pulseaudio-configuration make-pulseaudio-configuration
  pulseaudio-configuration?
  (client-conf pulseaudio-configuration-client-conf
               (default '()))
  (daemon-conf pulseaudio-configuration-daemon-conf
               ;; Flat volumes may cause unpleasant experiences to users
               ;; when applications inadvertently max out the system volume
               ;; (see e.g. <https://bugs.gnu.org/38172>).
               (default '((flat-volumes . no))))
  (script-file pulseaudio-configuration-script-file
               (default (file-append pulseaudio "/etc/pulse/default.pa")))
  (extra-script-files pulseaudio-configuration-extra-script-files
                      (default '()))
  (system-script-file pulseaudio-configuration-system-script-file
                      (default
                        (file-append pulseaudio "/etc/pulse/system.pa"))))

(define (pulseaudio-conf-entry arg)
  (match arg
    ((key . value)
     (format #f "~a = ~s~%" key value))
    ((? string? _)
     (string-append arg "\n"))))

(define pulseaudio-environment
  (match-lambda
    (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file)
     ;; These config files kept at a fixed location, so that the following
     ;; environment values are stable and do not require the user to reboot to
     ;; effect their PulseAudio configuration changes.
     '(("PULSE_CONFIG" . "/etc/pulse/daemon.conf")
       ("PULSE_CLIENTCONFIG" . "/etc/pulse/client.conf")))))

(define (extra-script-files->file-union extra-script-files)
  "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION."

  (define (file-like->name file)
    (match file
      ((? local-file?)
       (local-file-name file))
      ((? plain-file?)
       (plain-file-name file))
      ((? computed-file?)
       (computed-file-name file))
      (_ (leave (G_ "~a is not a local-file, plain-file or \
computed-file object~%") file))))

  (define (assert-pulseaudio-script-file-name name)
    (unless (string-suffix? ".pa" name)
      (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name))
    name)

  (let ((labels (map (compose assert-pulseaudio-script-file-name
                              file-like->name)
                     extra-script-files)))
    (file-union "default.pa.d" (zip labels extra-script-files))))

(define (append-include-directive script-file)
  "Append an include directive to source scripts under /etc/pulse/default.pa.d."
  (computed-file "default.pa"
                 #~(begin
                     (use-modules (ice-9 textual-ports))
                     (define script-text
                       (call-with-input-file #$script-file get-string-all))
                     (call-with-output-file #$output
                       (lambda (port)
                         (format port (string-append script-text "
### Added by Guix to include scripts specified in extra-script-files.
.nofail
.include /etc/pulse/default.pa.d~%")))))))

(define pulseaudio-etc
  (match-lambda
    (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file
                                   extra-script-files system-script-file)
     `(("pulse"
        ,(file-union
          "pulse"
          `(("default.pa"
             ,(if (null? extra-script-files)
                  default-script-file
                  (append-include-directive default-script-file)))
            ("system.pa" ,system-script-file)
            ,@(if (null? extra-script-files)
                  '()
                  `(("default.pa.d" ,(extra-script-files->file-union
                                      extra-script-files))))
            ("daemon.conf"
             ,(apply mixed-text-file "daemon.conf"
                     "default-script-file = /etc/pulse/default.pa\n"
                     (map pulseaudio-conf-entry daemon-conf)))
            ("client.conf"
             ,(apply mixed-text-file "client.conf"
                     (map pulseaudio-conf-entry client-conf))))))))))

(define pulseaudio-service-type
  (service-type
   (name 'pulseaudio)
   (extensions
    (list (service-extension session-environment-service-type
                             pulseaudio-environment)
          (service-extension etc-service-type pulseaudio-etc)
          (service-extension udev-service-type (const (list pulseaudio)))))
   (default-value (pulseaudio-configuration))
   (description "Configure PulseAudio sound support.")))


;;;
;;; LADSPA
;;;

(define-record-type* <ladspa-configuration>
  ladspa-configuration make-ladspa-configuration
  ladspa-configuration?
  (plugins ladspa-configuration-plugins (default '())))

(define (ladspa-environment config)
  ;; Define this variable in the global environment such that
  ;; pulseaudio swh-plugins (and similar LADSPA plugins) work.
  `(("LADSPA_PATH" .
     (string-join
      ',(map (lambda (package) (file-append package "/lib/ladspa"))
             (ladspa-configuration-plugins config))
      ":"))))

(define ladspa-service-type
  (service-type
   (name 'ladspa)
   (extensions
    (list (service-extension session-environment-service-type
                             ladspa-environment)))
   (default-value (ladspa-configuration))
   (description "Configure LADSPA plugins.")))

;;; sound.scm ends here
"vorbis-tools-CVE-2014-9640.patch" "vorbis-tools-CVE-2015-6749.patch")))) (build-system gnu-build-system) (inputs `(("ao" ,ao) ("curl" ,curl) ("flac" ,flac) ("libkate" ,libkate) ("libogg" ,libogg) ("libvorbis" ,libvorbis) ("speex" ,speex))) (native-inputs `(("pkg-config" ,pkg-config))) (synopsis "Ogg vorbis tools") (description "Ogg vorbis is a non-proprietary, patent-and-royalty-free, general-purpose compressed audio format. The package vorbis-tools contains ogg123, an ogg vorbis command line audio player; oggenc, the ogg vorbis encoder; oggdec, a simple, portable command line decoder (to wav and raw); ogginfo, to obtain information (tags, bitrate, length, etc.) about an ogg vorbis file.") (license license:gpl2) (home-page "https://xiph.org/vorbis/"))) (define opus (package (name "opus") (version "1.3.1") (source (origin (method url-fetch) (uri (string-append "https://archive.mozilla.org/pub/opus/opus-" version ".tar.gz")) (sha256 (base32 "17gz8kxs4i7icsc1gj713gadiapyklynlwqlf0ai98dj4lg8xdb5")))) (build-system gnu-build-system) (synopsis "Versatile audio codec") (description "Opus is a totally open, royalty-free, highly versatile audio codec. Opus is unmatched for interactive speech and music transmission over the Internet, but is also intended for storage and streaming applications. It is standardized by the Internet Engineering Task Force (IETF) as RFC 6716 which incorporated technology from Skype's SILK codec and Xiph.Org's CELT codec.") (license license:bsd-3) (home-page "https://www.opus-codec.org"))) (define opus-tools (package (name "opus-tools") (version "0.2") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/opus/opus-tools-" version ".tar.gz")) (sha256 (base32 "11pzl27s4vcz4m18ch72nivbhww2zmzn56wspb7rll1y1nq6rrdl")))) (build-system gnu-build-system) (arguments ;; The package developers misuse pkg-config such that it doesn't work ;; when cross compiling. Therefore we avoid it completly and set the ;; necessary flags ourselves. `(#:configure-flags (list (string-append "CFLAGS=-I" (assoc-ref %build-inputs "libogg") "/include -I" (assoc-ref %build-inputs "opus") "/include/opus")))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("libopusenc" ,libopusenc) ("opusfile" ,opusfile) ("flac" ,flac))) (synopsis "Command line utilities to encode, inspect, and decode .opus files") (description "Opus is a royalty-free, highly versatile audio codec. Opus-tools provide command line utilities for creating, inspecting and decoding .opus files.") (license license:bsd-3) (home-page "https://www.opus-codec.org"))) (define opusfile (package (name "opusfile") (version "0.11") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/opus/opusfile-" version ".tar.gz")) (sha256 (base32 "1gq3aszzl5glgbajw5p1f5a1kdyf23w5vjdmwwrk246syin9pkkl")))) (build-system gnu-build-system) ;; Required by opusfile.pc and opusurl.pc. (propagated-inputs `(("libogg" ,libogg) ("openssl" ,openssl) ("opus" ,opus))) (native-inputs `(("pkg-config" ,pkg-config))) (synopsis "Versatile audio codec") (description "The opusfile library provides seeking, decode, and playback of Opus streams in the Ogg container (.opus files) including over http(s) on posix and windows systems.") (license license:bsd-3) (home-page "https://www.opus-codec.org"))) (define-public libopusenc (package (name "libopusenc") (version "0.2.1") (source (origin (method url-fetch) (uri (string-append "https://archive.mozilla.org/pub/opus/" "libopusenc-" version ".tar.gz")) (sha256 (base32 "1ffb0vhlymlsq70pxsjj0ksz77yfm2x0a1x8q50kxmnkm1hxp642")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (propagated-inputs `(("opus" ,opus))) (synopsis "Library for encoding Opus audio files and streams ") (description "The libopusenc libraries provide a high-level API for encoding Opus files and streams.") (home-page "https://www.opus-codec.org/") (license license:bsd-3))) (define-public icecast (package (name "icecast") (version "2.4.4") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/icecast/icecast-" version ".tar.gz")) (sha256 (base32 "0i2d9rhav0x6js2qhjf5iy6j2a7f0d11ail0lfv40hb1kygrgda9")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("libxslt" ,libxslt) ("libxml2" ,libxml2) ("openssl" ,openssl) ("curl" ,curl) ("libogg" ,libogg) ("libvorbis" ,libvorbis) ("libtheora" ,libtheora) ("speex" ,speex))) (synopsis "Streaming media server") (description "Icecast is a streaming media server which currently supports Ogg (Vorbis and Theora), Opus, WebM and MP3 audio streams. It can be used to create an Internet radio station or a privately running jukebox and many things in between.") (home-page "https://icecast.org/") (license license:gpl2))) (define-public libshout (package (name "libshout") (version "2.4.2") (source (origin (method url-fetch) (uri (string-append "https://downloads.xiph.org/releases/libshout/" "libshout-" version ".tar.gz")) (sha256 (base32 "0qgwarqp2p6jy3zadds6dzj8z1jfb2mbwc3lsdlidf527h0a86ym")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) (propagated-inputs ;; shout.pc refers to all these. `(("libtheora" ,libtheora) ("libvorbis" ,libvorbis) ("speex" ,speex))) (home-page "https://icecast.org/") (synopsis "Audio streaming library for icecast encoders") (description "Libshout is a library for communicating with and sending data to an icecast server. It handles the socket connection, the timing of the data, and prevents bad data from getting to the icecast server.") (license license:gpl2+)))