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
es]: Use it instead of lambda function. * tests/crate.scm (test-doctool-crate, test-doctool-dependencies): New variables. ("self-test …", "cargo-recursive-import-hoors-existing-packages"): New tests. Hartmut Goebel 2020-12-02import: crate: Trim version for names after left-most non-zero part....This complies to how versions are matched for caret requirements in crates: An update is allowed if the new version number does not modify the left-most non-zero digit in the major, minor, patch grouping. * guix/import/crate.scm (version->semver-prefix): New function. (make-crate-sexp)[format-inputs]: Use it. (make-crate-sexp): Use it to pass shorter version to package->definition. * guix/import/utils.scm (package->definition): Change optional parameter APPEND-VERSION? into APPEND-VERSION?/STRING. If it is a string, append its value to name. * tests/crate.scm: Adjust tests accordingly. Hartmut Goebel 2020-12-02import: utils: Trim patch version from names....This remove the patch version from generated package names. For example 'rust-my-crate-1.1.2' now becomes 'rust-my-crate-1.1'. * guix/import/utils.scm (package->definition): Trim patch version from generated package names. * tests/crate.scm: (cargo>guix-package, cargo-recursive-import): Likewise. Hartmut Goebel 2020-12-02import: crate: Parameterized importing of dev dependencies....The recursive crate importer will now include development dependencies only for the top level package, but not for any of the recursively imported packages. Also #:skip-build will be false for the top-most package. * guix/import/crate.scm (make-crate-sexp): Add the key BUILD?. (crate->guix-package): Add the key INCLUDE-DEV-DEPS?. (crate-recursive-import): Likewise. * guix/scripts/import/crate.scm (guix-import-crate): Likewise. * tests/crate.scm (cargo-recursive-import): Likewise. Martin Becze 2020-12-02import: crate: Use guile-semver to resolve module versions....* guix/import/crate.scm: Add guile-semver as a soft dependency. (make-crate-sexp): Don't allow other keys. Add '#:skip-build?' to build system args. Pass a VERSION argument to 'cargo-inputs'. (crate->guix-package): Use guile-semver to resolve the correct module versions. Treat "build" dependencies as normal dependencies. (crate-name->package-name): Reuse the procedure 'guix-name' instead of duplicating its logic. * guix/import/utils.scm (package-names->package-inputs): Implement handling of (name version) pairs. * guix/scripts/import/crate.scm (guix-import-crate): Use crate-recursive-import instead of duplicate code. * tests/crate.scm (recursive-import): Change test packages versions to be distinguishable. Add version data to the test. Check created symbols, too. Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com> Martin Becze 2020-04-27tests: Remove trailing commas in JSON tests....These commas are rejected by Guile-JSON 3.5.0. * tests/crate.scm (test-foo-dependencies) (test-root-dependencies, test-intermediate-1-dependencies) (test-intermediate-2-dependencies): Remove trailing commas. * tests/gem.scm (test-bar-json): Likewise. * tests/pypi.scm (test-json): Likewise. Ludovic Courtès 2020-01-16import: crate: Export 'string->license'....* guix/import/crate.scm (string->license): Export. * tests/crate.scm (string->license): Remove. Ludovic Courtès 2019-12-11import: crate: Better handle license expressions....* guix/import/crate.scm (%dual-license-rx): Removed function. (crate->guix-package): Handle most of the multi-licensing cases. * tests/crate.scm (licenses): Add tests for some licenses. Co-authored-by: Ludovic Courtès <ludo@gnu.org> Brice Waegeneire 2019-12-11import: crate: Add recursive import test....* tests/crate.scm (test-crate): Rename to... (test-foo-crate): ... this. (test-dependencies): Rename to... (test-foo-dependencies): ... this. (test-root-crate, test-root-dependencies, test-intermediate-1-crate) (test-intermediate-1-dependencies, test-intermediate-2-crate) (test-intermediate-2-dependencies, test-leaf-alice-crate) (test-leaf-alice-dependencies, test-leaf-bob-crate) (test-leaf-bob-dependencies): New variables. ("crate->guix-package"): Adjust accordingly. ("cargo-recursive-import"): New test. Co-authored-by: Ludovic Courtès <ludo@gnu.org> Brian Leung 2019-09-04import: crate: Correct interpretation of dual-licensing strings....* guix/import/crate.scm (%dual-license-rx): New variable. (crate->guix-package)[string->license]: Rewrite to match it. * tests/crate.scm (test-crate): Adjust "license" field to current practice. Ludovic Courtès 2019-09-04import: crate: Separate crates.io API from actual conversion....This provides a clean separation between bindings to the https://crates.io/api/v1 API and actual conversion to Guix package sexps. As a side-effect, it fixes things like "guix import blake2-rfc", "guix refresh -t crates", etc. * guix/import/crate.scm (<crate>, <crate-version>, <crate-dependency>): New record types. (lookup-crate, crate-version-dependencies): New procedures. (crate-fetch): Remove. (crate->guix-package): Rewrite to use the new API. (latest-release): Likewise. * guix/build-system/cargo.scm (%crate-base-url): New variable. * tests/crate.scm (test-crate): Update accordingly. fixlet Ludovic Courtès 2019-06-30guix: import: crate: fix redundant inputs list nesting...* guix/import/crate.scm (maybe-cargo-inputs): Remove one level of lists. * guix/import/crate.scm (maybe-cargo-development-inputs): Same. * tests/crate.scm: (crate->guix-package)[package]<#:arguments>: Remove one level of list nesting. Ivan Petkov 2019-06-11import: crate: Define dependencies as arguments....* guix/import/crate.scm: (crate-fetch)[input-crates]: Rename to dev-crates. [native-input-crates]: Rename to dev-dep-crates. [inputs]: Rename to cargo-inputs. [native-inputs]: Rename to cargo-development-inputs. (maybe-cargo-inputs, maybe-cargo-development-inputs, maybe-arguments): Add them. (make-crate-sexp)[inputs]: Rename to cargo-inputs. [native-inputs]: Rename to cargo-development-inputs. [maybe-native-inputs, maybe-inputs]: Replace with maybe-arguments. * guix/import/utils.scm: (package-names->package-inputs): Make public. Add docstring. * tests/crate.scm (crate->guix-package): Update the match pattern. Signed-off-by: Chris Marusich <cmmarusich@gmail.com> Ivan Petkov 2018-09-04Switch to Guile-Gcrypt....This removes (guix hash) and (guix pk-crypto), which now live as part of Guile-Gcrypt (version 0.1.0.) * guix/gcrypt.scm, guix/hash.scm, guix/pk-crypto.scm, tests/hash.scm, tests/pk-crypto.scm: Remove. * configure.ac: Test for Guile-Gcrypt. Remove LIBGCRYPT and LIBGCRYPT_LIBDIR assignments. * m4/guix.m4 (GUIX_ASSERT_LIBGCRYPT_USABLE): Remove. * README: Add Guile-Gcrypt to the dependencies; move libgcrypt as "required unless --disable-daemon". * doc/guix.texi (Requirements): Likewise. * gnu/packages/bash.scm, guix/derivations.scm, guix/docker.scm, guix/git.scm, guix/http-client.scm, guix/import/cpan.scm, guix/import/cran.scm, guix/import/crate.scm, guix/import/elpa.scm, guix/import/gnu.scm, guix/import/hackage.scm, guix/import/texlive.scm, guix/import/utils.scm, guix/nar.scm, guix/pki.scm, guix/scripts/archive.scm, guix/scripts/authenticate.scm, guix/scripts/download.scm, guix/scripts/hash.scm, guix/scripts/pack.scm, guix/scripts/publish.scm, guix/scripts/refresh.scm, guix/scripts/substitute.scm, guix/store.scm, guix/store/deduplication.scm, guix/tests.scm, tests/base32.scm, tests/builders.scm, tests/challenge.scm, tests/cpan.scm, tests/crate.scm, tests/derivations.scm, tests/gem.scm, tests/nar.scm, tests/opam.scm, tests/pki.scm, tests/publish.scm, tests/pypi.scm, tests/store-deduplication.scm, tests/store.scm, tests/substitute.scm: Adjust imports. * gnu/system/vm.scm: Likewise. (guile-sqlite3&co): Rename to... (gcrypt-sqlite3&co): ... this. Add GUILE-GCRYPT. (expression->derivation-in-linux-vm)[config]: Remove. (iso9660-image)[config]: Remove. (qemu-image)[config]: Remove. (system-docker-image)[config]: Remove. * guix/scripts/pack.scm: Adjust imports. (guile-sqlite3&co): Rename to... (gcrypt-sqlite3&co): ... this. Add GUILE-GCRYPT. (self-contained-tarball)[build]: Call 'make-config.scm' without #:libgcrypt argument. (squashfs-image)[libgcrypt]: Remove. [build]: Call 'make-config.scm' without #:libgcrypt. (docker-image)[config, json]: Remove. [build]: Add GUILE-GCRYPT to the extensions Remove (guix config) from the imported modules. * guix/self.scm (specification->package): Remove "libgcrypt", add "guile-gcrypt". (compiled-guix): Remove #:libgcrypt. [guile-gcrypt]: New variable. [dependencies]: Add it. [*core-modules*]: Remove #:libgcrypt from 'make-config.scm' call. Add #:extensions. [*config*]: Remove #:libgcrypt from 'make-config.scm' call. (%dependency-variables): Remove %libgcrypt. (make-config.scm): Remove #:libgcrypt. * build-aux/build-self.scm (guile-gcrypt): New variable. (make-config.scm): Remove #:libgcrypt. (build-program)[fake-gcrypt-hash]: New variable. Add (gcrypt hash) to the imported modules. Adjust load path assignments. * gnu/packages/package-management.scm (guix)[propagated-inputs]: Add GUILE-GCRYPT. [arguments]: In 'wrap-program' phase, add GUILE-GCRYPT to the search path. Ludovic Courtès 2017-02-13tests: Adjust for 'http-fetch' change in (guix import json)....This is a followup to commit 81e0bc1834490a1a8092c75a0733b15c2b407285. * tests/cpan.scm ("cpan->guix-package"): Add a 'rest' argument to the lambda that mocks 'http-fetch'. * tests/crate.scm ("crate->guix-package"): Likewise. * tests/gem.scm ("gem->guix-package"): Likewise. * tests/pypi.scm ("pypi->guix-package"): Likewise. ("pypi->guix-package, wheels"): Likewise. Ludovic Courtès 2017-01-01build-system: cargo: Handle Cargo.lock file not present....* guix/build-system/cargo.scm (cargo-build): Add src output. (private-keywords): Add #:outputs. * guix/build/cargo-build-system.scm (configure): Use /share/rust-source when replacing inputs. (build, check): Don't do anything when there isn't a Cargo.lock file present. (install): Install sources to src output. When a Cargo.lock file is present use cargo install to install binaries to out. * guix/import/crate.scm (make-crate-sexp): Importer uses the src output for crate inputs by default. * guix/import/utils.scm (package-names->package-inputs, maybe-inputs, maybe-native-inputs): Take an optional output argument. * tests/crate.scm (crate->guix-package test): Update. Problem reported by Francisco Gómez García <espectalll@kydara.com>. David Craven 2017-01-01import: crate: Provide a default home-page value....* guix/import/crate.scm (make-crate-sexp): Provide a default home-page value. * tests/crate.scm (test-crate): Add repository field. Problem reported by ng0 <ng0@libertad.pw>. David Craven 2016-12-14import: Add importer for rust crates....* guix/import/crate.scm: New file. * guix/scripts/import/crate.scm: New file. * guix/scripts/import.scm (importers): Add crate importer. * tests/crate.scm: New file. * doc/guix.texi: Add crate importer to table. * Makefile.am (MODULES, SCM_TESTS): Add files. David Craven