diff options
author | Christopher Baines <mail@cbaines.net> | 2023-03-02 10:37:28 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-03-02 10:55:08 +0000 |
commit | 7df09ee0ab3e7962ef27859ce87e06a323059284 (patch) | |
tree | d81334f742ddcb9a1ee63961ca6410922980af1c /gnu/services | |
parent | 2ac51ec99b58b50c08ba719a8c7e9dba0330b065 (diff) | |
parent | af95f2d8f98eb2c8c64954bb2fd0b70838899174 (diff) | |
download | guix-7df09ee0ab3e7962ef27859ce87e06a323059284.tar.gz guix-7df09ee0ab3e7962ef27859ce87e06a323059284.zip |
Merge remote-tracking branch 'savannah/master' into core-updates
Conflicts:
gnu/local.mk
gnu/packages/autotools.scm
gnu/packages/cmake.scm
gnu/packages/gnuzilla.scm
gnu/packages/haskell.scm
gnu/packages/pdf.scm
gnu/packages/python-xyz.scm
gnu/packages/samba.scm
gnu/packages/tex.scm
gnu/packages/tls.scm
gnu/packages/wxwidgets.scm
Diffstat (limited to 'gnu/services')
-rw-r--r-- | gnu/services/audio.scm | 902 | ||||
-rw-r--r-- | gnu/services/base.scm | 87 | ||||
-rw-r--r-- | gnu/services/configuration.scm | 3 | ||||
-rw-r--r-- | gnu/services/desktop.scm | 107 | ||||
-rw-r--r-- | gnu/services/guix.scm | 85 | ||||
-rw-r--r-- | gnu/services/lightdm.scm | 2 | ||||
-rw-r--r-- | gnu/services/monitoring.scm | 6 | ||||
-rw-r--r-- | gnu/services/networking.scm | 64 | ||||
-rw-r--r-- | gnu/services/telephony.scm | 8 |
9 files changed, 1049 insertions, 215 deletions
diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index c60053f33c..d55b804ba9 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022 Bruno Victal <mirai@makinata.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,19 +21,108 @@ (define-module (gnu services audio) #:use-module (guix gexp) + #:use-module (guix deprecation) + #:use-module (guix diagnostics) + #:use-module (guix i18n) #:use-module (gnu services) + #:use-module (gnu services admin) + #:use-module (gnu services configuration) #:use-module (gnu services shepherd) + #:use-module (gnu services admin) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages mpd) #:use-module (guix records) - #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:export (mpd-output mpd-output? + mpd-output-name + mpd-output-type + mpd-output-enabled? + mpd-output-format + mpd-output-tags? + mpd-output-always-on? + mpd-output-mixer-type + mpd-output-replay-gain-handler + mpd-output-extra-options + + mpd-plugin + mpd-plugin? + mpd-plugin-plugin + mpd-plugin-name + mpd-plugin-enabled? + mpd-plugin-extra-options + + mpd-partition + mpd-partition? + mpd-partition-name + mpd-partition-extra-options + mpd-configuration mpd-configuration? - mpd-service-type)) + mpd-configuration-package + mpd-configuration-user + mpd-configuration-group + mpd-configuration-shepherd-requirement + mpd-configuration-log-file + mpd-configuration-log-level + mpd-configuration-music-directory + mpd-configuration-music-dir + mpd-configuration-playlist-directory + mpd-configuration-playlist-dir + mpd-configuration-db-file + mpd-configuration-state-file + mpd-configuration-sticker-file + mpd-configuration-default-port + mpd-configuration-endpoints + mpd-configuration-address + mpd-configuration-database + mpd-configuration-partitions + mpd-configuration-neighbors + mpd-configuration-inputs + mpd-configuration-archive-plugins + mpd-configuration-input-cache-size + mpd-configuration-decoders + mpd-configuration-resampler + mpd-configuration-filters + mpd-configuration-outputs + mpd-configuration-playlist-plugins + mpd-configuration-extra-options + mpd-service-type + + mympd-service-type + mympd-configuration + mympd-configuration? + mympd-configuration-package + mympd-configuration-shepherd-requirement + mympd-configuration-user + mympd-configuration-group + mympd-configuration-work-directory + mympd-configuration-cache-directory + mympd-configuration-acl + mympd-configuration-covercache-ttl + mympd-configuration-http? + mympd-configuration-host + mympd-configuration-port + mympd-configuration-log-level + mympd-configuration-log-to + mympd-configuration-lualibs + mympd-configuration-uri + mympd-configuration-script-acl + mympd-configuration-ssl? + mympd-configuration-ssl-port + mympd-configuration-ssl-cert + mympd-configuration-ssl-key + mympd-configuration-pin-hash + mympd-configuration-save-caches? + mympd-ip-acl + mympd-ip-acl? + mympd-ip-acl-allow + mympd-ip-acl-deny)) ;;; Commentary: ;;; @@ -40,150 +130,433 @@ ;;; ;;; Code: -(define-record-type* <mpd-output> - mpd-output make-mpd-output - mpd-output? - (type mpd-output-type - (default "pulse")) - (name mpd-output-name - (default "MPD")) - (enabled? mpd-output-enabled? - (default #t)) - (tags? mpd-output-tags? - (default #t)) - (always-on? mpd-output-always-on? - (default #f)) - (mixer-type mpd-output-mixer-type - ;; valid: hardware, software, null, none - (default #f)) - (extra-options mpd-output-extra-options - (default '()))) - -(define-record-type* <mpd-configuration> - mpd-configuration make-mpd-configuration - mpd-configuration? - (user mpd-configuration-user - (default "mpd")) - (music-dir mpd-configuration-music-dir - (default "~/Music")) - (playlist-dir mpd-configuration-playlist-dir - (default "~/.mpd/playlists")) - (db-file mpd-configuration-db-file - (default "~/.mpd/tag_cache")) - (state-file mpd-configuration-state-file - (default "~/.mpd/state")) - (sticker-file mpd-configuration-sticker-file - (default "~/.mpd/sticker.sql")) - (port mpd-configuration-port - (default "6600")) - (address mpd-configuration-address - (default "any")) - (outputs mpd-configuration-outputs - (default (list (mpd-output))))) - -(define (mpd-output->string output) - "Convert the OUTPUT of type <mpd-output> to a configuration file snippet." - (let ((extra (string-join - (map (match-lambda - ((key . value) - (format #f " ~a \"~a\"" - (string-map - (lambda (c) (if (char=? c #\-) #\_ c)) - (symbol->string key)) - value))) - (mpd-output-extra-options output)) - "\n"))) - (format #f "\ -audio_output { - type \"~a\" - name \"~a\" -~:[ enabled \"no\"~%~;~]\ -~:[ tags \"no\"~%~;~]\ -~:[~; always_on \"yes\"~%~]\ -~@[ mixer_type \"~a\"~%~]\ -~a~%}~%" - (mpd-output-type output) - (mpd-output-name output) - (mpd-output-enabled? output) - (mpd-output-tags? output) - (mpd-output-always-on? output) - (mpd-output-mixer-type output) - extra))) - -(define (mpd-config->file config) - (apply - mixed-text-file "mpd.conf" - "pid_file \"" (mpd-file-name config "pid") "\"\n" - (append (map mpd-output->string - (mpd-configuration-outputs config)) - (map (match-lambda - ((config-name config-val) - (string-append config-name " \"" (config-val config) "\"\n"))) - `(("user" ,mpd-configuration-user) - ("music_directory" ,mpd-configuration-music-dir) - ("playlist_directory" ,mpd-configuration-playlist-dir) - ("db_file" ,mpd-configuration-db-file) - ("state_file" ,mpd-configuration-state-file) - ("sticker_file" ,mpd-configuration-sticker-file) - ("port" ,mpd-configuration-port) - ("bind_to_address" ,mpd-configuration-address)))))) - -(define (mpd-file-name config file) - "Return a path in /var/run/mpd/ that is writable - by @code{user} from @code{config}." - (string-append "/var/run/mpd/" - (mpd-configuration-user config) - "/" file)) +(define (uglify-field-name field-name) + (let ((str (symbol->string field-name))) + (string-join (string-split (if (string-suffix? "?" str) + (string-drop-right str 1) + str) + #\-) "_"))) + +(define list-of-string? + (list-of string?)) + +(define list-of-symbol? + (list-of symbol?)) + +(define (mpd-serialize-field field-name value) + (let ((field (if (string? field-name) field-name + (uglify-field-name field-name))) + (value (cond + ((boolean? value) (if value "yes" "no")) + ((string? value) value) + (else (object->string value))))) + #~(format #f "~a ~s~%" #$field #$value))) + +(define (mpd-serialize-alist field-name value) + #~(string-append #$@(generic-serialize-alist list mpd-serialize-field + value))) + +(define mpd-serialize-string mpd-serialize-field) +(define mpd-serialize-boolean mpd-serialize-field) + +(define (mpd-serialize-list-of-string field-name value) + #~(string-append #$@(map (cut mpd-serialize-string field-name <>) value))) + +(define-maybe string (prefix mpd-)) +(define-maybe list-of-string (prefix mpd-)) +(define-maybe boolean (prefix mpd-)) + +;;; TODO: Procedures for deprecated fields, to be removed. + +(define mpd-deprecated-fields '((music-dir . music-directory) + (playlist-dir . playlist-directory) + (address . endpoints))) + +(define (port? value) (or (string? value) (integer? value))) + +(define (mpd-serialize-deprecated-field field-name value) + (if (maybe-value-set? value) + (begin + (warn-about-deprecation + field-name #f + #:replacement (assoc-ref mpd-deprecated-fields field-name)) + (match field-name + ('playlist-dir (mpd-serialize-string "playlist_directory" value)) + ('music-dir (mpd-serialize-string "music_directory" value)) + ('address (mpd-serialize-string "bind_to_address" value)))) + "")) + +(define (mpd-serialize-port field-name value) + (when (string? value) + (warning + (G_ "string value for '~a' is deprecated, use integer instead~%") + field-name)) + (mpd-serialize-field "port" value)) + +(define-maybe port (prefix mpd-)) + +;;; + +;; Generic MPD plugin record, lists only the most prevalent fields. +(define-configuration mpd-plugin + (plugin + maybe-string + "Plugin name.") + + (name + maybe-string + "Name.") + + (enabled? + maybe-boolean + "Whether the plugin is enabled/disabled.") + + (extra-options + (alist '()) + "An association list of option symbols/strings to string values +to be appended to the plugin configuration. See +@uref{https://mpd.readthedocs.io/en/latest/plugins.html,MPD plugin reference} +for available options.") + + (prefix mpd-)) + +(define (mpd-serialize-mpd-plugin field-name value) + #~(format #f "~a {~%~a}~%" + '#$field-name + #$(serialize-configuration value mpd-plugin-fields))) + +(define (mpd-serialize-list-of-mpd-plugin field-name value) + #~(string-append #$@(map (cut mpd-serialize-mpd-plugin field-name <>) + value))) + +(define list-of-mpd-plugin? (list-of mpd-plugin?)) + +(define-maybe mpd-plugin (prefix mpd-)) + +(define-configuration mpd-partition + (name + string + "Partition name.") + + (extra-options + (alist '()) + "An association list of option symbols/strings to string values +to be appended to the partition configuration. See +@uref{https://mpd.readthedocs.io/en/latest/user.html#configuring-partitions,Configuring Partitions} +for available options.") + + (prefix mpd-)) + +(define (mpd-serialize-mpd-partition field-name value) + #~(format #f "partition {~%~a}~%" + #$(serialize-configuration value mpd-partition-fields))) + +(define (mpd-serialize-list-of-mpd-partition field-name value) + #~(string-append #$@(map (cut mpd-serialize-mpd-partition #f <>) value))) + +(define list-of-mpd-partition? + (list-of mpd-partition?)) + +(define-configuration mpd-output + (name + (string "MPD") + "The name of the audio output.") + + (type + (string "pulse") + "The type of audio output.") + + (enabled? + (boolean #t) + "Specifies whether this audio output is enabled when MPD is started. By +default, all audio outputs are enabled. This is just the default +setting when there is no state file; with a state file, the previous +state is restored.") + + (format + maybe-string + "Force a specific audio format on output. See +@uref{https://mpd.readthedocs.io/en/latest/user.html#audio-output-format,Global Audio Format} +for a more detailed description.") + + (tags? + (boolean #t) + "If set to @code{#f}, then MPD will not send tags to this output. This +is only useful for output plugins that can receive tags, for example the +@code{httpd} output plugin.") + + (always-on? + (boolean #f) + "If set to @code{#t}, then MPD attempts to keep this audio output always +open. This may be useful for streaming servers, when you don’t want to +disconnect all listeners even when playback is accidentally stopped.") + + (mixer-type + (string "none") + "This field accepts a string that specifies which mixer should be used +for this audio output: the @code{hardware} mixer, the @code{software} +mixer, the @code{null} mixer (allows setting the volume, but with no +effect; this can be used as a trick to implement an external mixer +External Mixer) or no mixer (@code{none}).") + + (replay-gain-handler + maybe-string + "This field accepts a string that specifies how +@uref{https://mpd.readthedocs.io/en/latest/user.html#replay-gain,Replay Gain} +is to be applied. @code{software} uses an internal software volume control, +@code{mixer} uses the configured (hardware) mixer control and @code{none} +disables replay gain on this audio output.") + + (extra-options + (alist '()) + "An association list of option symbols/strings to string values +to be appended to the audio output configuration.") + + (prefix mpd-)) + +(define (mpd-serialize-mpd-output field-name value) + #~(format #f "audio_output {~%~a}~%" + #$(serialize-configuration value mpd-output-fields))) + +(define (mpd-serialize-list-of-mpd-plugin-or-output field-name value) + (let ((plugins outputs (partition mpd-plugin? value))) + #~(string-append #$@(map (cut mpd-serialize-mpd-plugin "audio_output" <>) + plugins) + #$@(map (cut mpd-serialize-mpd-output #f <>) outputs)))) + +(define list-of-mpd-plugin-or-output? + (list-of (lambda (x) + (or (mpd-output? x) (mpd-plugin? x))))) + +(define-configuration mpd-configuration + (package + (file-like mpd) + "The MPD package." + empty-serializer) + + (user + (string "mpd") + "The user to run mpd as.") + + (group + (string "mpd") + "The group to run mpd as.") + + (shepherd-requirement + (list-of-symbol '()) + "This is a list of symbols naming Shepherd services that this service +will depend on." + empty-serializer) + + (environment-variables + (list-of-string '()) + "A list of strings specifying environment variables." + empty-serializer) + + (log-file + (maybe-string "/var/log/mpd/log") + "The location of the log file. Set to @code{syslog} to use the +local syslog daemon or @code{%unset-value} to omit this directive +from the configuration file.") + + (log-level + maybe-string + "Supress any messages below this threshold. +Available values: @code{notice}, @code{info}, @code{verbose}, +@code{warning} and @code{error}.") + + (music-directory + maybe-string + "The directory to scan for music files.") + + (music-dir ; TODO: deprecated, remove later + maybe-string + "The directory to scan for music files." + mpd-serialize-deprecated-field) + + (playlist-directory + maybe-string + "The directory to store playlists.") + + (playlist-dir ; TODO: deprecated, remove later + maybe-string + "The directory to store playlists." + mpd-serialize-deprecated-field) + + (db-file + maybe-string + "The location of the music database.") + + (state-file + maybe-string + "The location of the file that stores current MPD's state.") + + (sticker-file + maybe-string + "The location of the sticker database.") + + (default-port + (maybe-port 6600) + "The default port to run mpd on.") + + (endpoints + maybe-list-of-string + "The addresses that mpd will bind to. A port different from +@var{default-port} may be specified, e.g. @code{localhost:6602} and +IPv6 addresses must be enclosed in square brackets when a different +port is used. +To use a Unix domain socket, an absolute path or a path starting with @code{~} +can be specified here." + (lambda (_ endpoints) + (if (maybe-value-set? endpoints) + (mpd-serialize-list-of-string "bind_to_address" endpoints) + ""))) + + (address ; TODO: deprecated, remove later + maybe-string + "The address that mpd will bind to. +To use a Unix domain socket, an absolute path can be specified here." + mpd-serialize-deprecated-field) + + (database + maybe-mpd-plugin + "MPD database plugin configuration.") + + (partitions + (list-of-mpd-partition '()) + "List of MPD \"partitions\".") + + (neighbors + (list-of-mpd-plugin '()) + "List of MPD neighbor plugin configurations.") + + (inputs + (list-of-mpd-plugin '()) + "List of MPD input plugin configurations." + (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "input" x))) + + (archive-plugins + (list-of-mpd-plugin '()) + "List of MPD archive plugin configurations." + (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "archive_plugin" x))) + + (input-cache-size + maybe-string + "MPD input cache size." + (lambda (_ x) + (if (maybe-value-set? x) + #~(string-append "\ninput_cache {\n" + #$(mpd-serialize-string "size" x) + "}\n") ""))) + + (decoders + (list-of-mpd-plugin '()) + "List of MPD decoder plugin configurations." + (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "decoder" x))) + + (resampler + maybe-mpd-plugin + "MPD resampler plugin configuration.") + + (filters + (list-of-mpd-plugin '()) + "List of MPD filter plugin configurations." + (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "filter" x))) + + (outputs + (list-of-mpd-plugin-or-output (list (mpd-output))) + "The audio outputs that MPD can use. +By default this is a single output using pulseaudio.") + + (playlist-plugins + (list-of-mpd-plugin '()) + "List of MPD playlist plugin configurations." + (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "playlist_plugin" x))) + + (extra-options + (alist '()) + "An association list of option symbols/strings to string values to be +appended to the configuration.") + + (prefix mpd-)) + +(define (mpd-serialize-configuration configuration) + (mixed-text-file + "mpd.conf" + (serialize-configuration configuration mpd-configuration-fields))) + +(define (mpd-log-rotation config) + (match-record config <mpd-configuration> (log-file) + (log-rotation + (files (list log-file)) + (post-rotate #~(begin + (use-modules (gnu services herd)) + (with-shepherd-action 'mpd ('reopen) #f)))))) (define (mpd-shepherd-service config) - (shepherd-service - (documentation "Run the MPD (Music Player Daemon)") - (requirement '(user-processes)) - (provision '(mpd)) - (start #~(make-forkexec-constructor - (list #$(file-append mpd "/bin/mpd") - "--no-daemon" - #$(mpd-config->file config)) - #:environment-variables - ;; Required to detect PulseAudio when run under a user account. - (list (string-append - "XDG_RUNTIME_DIR=/run/user/" - (number->string - (passwd:uid - (getpwnam #$(mpd-configuration-user config)))))) - #:log-file #$(mpd-file-name config "log"))) - (stop #~(make-kill-destructor)))) - -(define (mpd-service-activation config) - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils)) - (define %user - (getpw #$(mpd-configuration-user config))) - - (let ((directory #$(mpd-file-name config ".mpd"))) - (mkdir-p directory) - (chown directory (passwd:uid %user) (passwd:gid %user)) - - ;; Make /var/run/mpd/USER user-owned as well. - (chown (dirname directory) - (passwd:uid %user) (passwd:gid %user)))))) - - -(define %mpd-accounts - ;; Default account and group for MPD. - (list (user-group (name "mpd") (system? #t)) - (user-account - (name "mpd") - (group "mpd") - (system? #t) - (comment "Music Player Daemon (MPD) user") - - ;; Note: /var/run/mpd hosts one sub-directory per user, of which - ;; /var/run/mpd/mpd corresponds to the "mpd" user. - (home-directory "/var/run/mpd/mpd") - - (shell (file-append shadow "/sbin/nologin"))))) + (match-record config <mpd-configuration> (user package shepherd-requirement + log-file playlist-directory + db-file state-file sticker-file + environment-variables) + (let* ((config-file (mpd-serialize-configuration config))) + (shepherd-service + (documentation "Run the MPD (Music Player Daemon)") + (requirement `(user-processes loopback ,@shepherd-requirement)) + (provision '(mpd)) + (start #~(begin + (and=> #$(maybe-value log-file) + (compose mkdir-p dirname)) + + (let ((user (getpw #$user))) + (for-each + (lambda (x) + (when (and x (not (file-exists? x))) + (mkdir-p x) + (chown x (passwd:uid user) (passwd:gid user)))) + (list #$(maybe-value playlist-directory) + (and=> #$(maybe-value db-file) dirname) + (and=> #$(maybe-value state-file) dirname) + (and=> #$(maybe-value sticker-file) dirname)))) + + (make-forkexec-constructor + (list #$(file-append package "/bin/mpd") + "--no-daemon" + #$config-file) + #:environment-variables '#$environment-variables))) + (stop #~(make-kill-destructor)) + (actions + (list (shepherd-configuration-action config-file) + (shepherd-action + (name 'reopen) + (documentation "Re-open log files and flush caches.") + (procedure + #~(lambda (pid) + (if pid + (begin + (kill pid SIGHUP) + (format #t + "Issued SIGHUP to Service MPD (PID ~a)." + pid)) + (format #t "Service MPD is not running."))))))))))) + +(define (mpd-accounts config) + (match-record config <mpd-configuration> (user group) + (list (user-group + (name group) + (system? #t)) + (user-account + (name user) + (group group) + (system? #t) + (comment "Music Player Daemon (MPD) user") + ;; MPD can use $HOME (or $XDG_CONFIG_HOME) to place its data + (home-directory "/var/lib/mpd") + (shell (file-append shadow "/sbin/nologin")))))) (define mpd-service-type (service-type @@ -193,7 +566,242 @@ audio_output { (list (service-extension shepherd-root-service-type (compose list mpd-shepherd-service)) (service-extension account-service-type - (const %mpd-accounts)) - (service-extension activation-service-type - mpd-service-activation))) + mpd-accounts) + (service-extension rottlog-service-type + (compose list mpd-log-rotation)))) (default-value (mpd-configuration)))) + + +;;; +;;; myMPD +;;; + +(define (string-or-symbol? x) + (or (symbol? x) (string? x))) + +(define-configuration/no-serialization mympd-ip-acl + (allow + (list-of-string '()) + "Allowed IP addresses.") + + (deny + (list-of-string '()) + "Disallowed IP addresses.")) + +(define-maybe/no-serialization integer) +(define-maybe/no-serialization mympd-ip-acl) + +;; XXX: The serialization procedures are insufficient since we require +;; access to multiple fields at once. +;; Fields marked with empty-serializer are never serialized and are +;; used for command-line arguments or by the service definition. +(define-configuration/no-serialization mympd-configuration + (package + (file-like mympd) + "The package object of the myMPD server." + empty-serializer) + + (shepherd-requirement + (list-of-symbol '()) + "This is a list of symbols naming Shepherd services that this service +will depend on." + empty-serializer) + + (user + (string "mympd") + "Owner of the @command{mympd} process." + empty-serializer) + + (group + (string "nogroup") + "Owner group of the @command{mympd} process." + empty-serializer) + + (work-directory + (string "/var/lib/mympd") + "Where myMPD will store its data." + empty-serializer) + + (cache-directory + (string "/var/cache/mympd") + "Where myMPD will store its cache." + empty-serializer) + + (acl + maybe-mympd-ip-acl + "ACL to access the myMPD webserver.") + + (covercache-ttl + (maybe-integer 31) + "How long to keep cached covers, @code{0} disables cover caching.") + + (http? + (boolean #t) + "HTTP support.") + + (host + (string "[::]") + "Host name to listen on.") + + (port + (maybe-port 80) + "HTTP port to listen on.") + + (log-level + (integer 5) + "How much detail to include in logs, possible values: @code{0} to @code{7}.") + + (log-to + (string-or-symbol "/var/log/mympd/log") + "Where to send logs. By default, the service logs to +@file{/var/log/mympd.log}. The alternative is @code{'syslog}, which +sends output to the running syslog service under the @samp{daemon} facility." + empty-serializer) + + (lualibs + (maybe-string "all") + "See +@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.") + + (uri + maybe-string + "Override URI to myMPD. +See @url{https://github.com/jcorporation/myMPD/issues/950}.") + + (script-acl + (maybe-mympd-ip-acl (mympd-ip-acl + (allow '("127.0.0.1")))) + "ACL to access the myMPD script backend.") + + (ssl? + (boolean #f) + "SSL/TLS support.") + + (ssl-port + (maybe-port 443) + "Port to listen for HTTPS.") + + (ssl-cert + maybe-string + "Path to PEM encoded X.509 SSL/TLS certificate (public key).") + + (ssl-key + maybe-string + "Path to PEM encoded SSL/TLS private key.") + + (pin-hash + maybe-string + "SHA-256 hashed pin used by myMPD to control settings access by +prompting a pin from the user.") + + (save-caches? + maybe-boolean + "Whether to preserve caches between service restarts.")) + +(define (mympd-serialize-configuration config) + (define serialize-value + (match-lambda + ((? boolean? val) (if val "true" "false")) + ((? integer? val) (number->string val)) + ((? mympd-ip-acl? val) (ip-acl-serialize-configuration val)) + ((? string? val) val))) + + (define (ip-acl-serialize-configuration config) + (define (serialize-list-of-string prefix lst) + (map (cut format #f "~a~a" prefix <>) lst)) + (string-join + (append + (serialize-list-of-string "+" (mympd-ip-acl-allow config)) + (serialize-list-of-string "-" (mympd-ip-acl-deny config))) ",")) + + ;; myMPD configuration fields are serialized as individual files under + ;; <work-directory>/config/. + (match-record config <mympd-configuration> (work-directory acl + covercache-ttl http? host port + log-level lualibs uri script-acl + ssl? ssl-port ssl-cert ssl-key + pin-hash save-caches?) + (define (serialize-field filename value) + (when (maybe-value-set? value) + (list (format #f "~a/config/~a" work-directory filename) + (mixed-text-file filename (serialize-value value))))) + + (let ((filename-to-field `(("acl" . ,acl) + ("covercache_keep_days" . ,covercache-ttl) + ("http" . ,http?) + ("http_host" . ,host) + ("http_port" . ,port) + ("loglevel" . ,log-level) + ("lualibs" . ,lualibs) + ("mympd_uri" . ,uri) + ("scriptacl" . ,script-acl) + ("ssl" . ,ssl?) + ("ssl_port" . ,ssl-port) + ("ssl_cert" . ,ssl-cert) + ("ssl_key" . ,ssl-key) + ("pin_hash" . ,pin-hash) + ("save_caches" . ,save-caches?)))) + (filter list? + (generic-serialize-alist list serialize-field + filename-to-field))))) + +(define (mympd-shepherd-service config) + (match-record config <mympd-configuration> (package shepherd-requirement + user work-directory + cache-directory log-level log-to) + (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level))) + (shepherd-service + (documentation "Run the myMPD daemon.") + (requirement `(loopback user-processes ,@shepherd-requirement)) + (provision '(mympd)) + (start #~(begin + (let* ((pw (getpwnam #$user)) + (uid (passwd:uid pw)) + (gid (passwd:gid pw))) + (for-each (lambda (dir) + (mkdir-p dir) + (chown dir uid gid)) + (list #$work-directory #$cache-directory))) + + (make-forkexec-constructor + `(#$(file-append package "/bin/mympd") + "--user" #$user + #$@(if (eqv? log-to 'syslog) '("--syslog") '()) + "--workdir" #$work-directory + "--cachedir" #$cache-directory) + #:environment-variables (list #$log-level*) + #:log-file #$(if (string? log-to) log-to #f)))) + (stop #~(make-kill-destructor)))))) + +(define (mympd-accounts config) + (match-record config <mympd-configuration> (user group) + (list (user-group (name group) + (system? #t)) + (user-account (name user) + (group group) + (system? #t) + (comment "myMPD user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin")))))) + +(define (mympd-log-rotation config) + (match-record config <mympd-configuration> (log-to) + (if (string? log-to) + (list (log-rotation + (files (list log-to)))) + '()))) + +(define mympd-service-type + (service-type + (name 'mympd) + (extensions + (list (service-extension shepherd-root-service-type + (compose list mympd-shepherd-service)) + (service-extension account-service-type + mympd-accounts) + (service-extension special-files-service-type + mympd-serialize-configuration) + (service-extension rottlog-service-type + mympd-log-rotation))) + (description "Run myMPD, a frontend for MPD. (Music Player Daemon)") + (default-value (mympd-configuration)))) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 9e799445d2..7ad1e765bd 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -20,6 +20,7 @@ ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li> ;;; Copyright © 2022 ( <paren@disroot.org> +;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,6 +65,7 @@ #:select (coreutils glibc glibc-utf8-locales tar canonical-package)) #:use-module ((gnu packages compression) #:select (gzip)) + #:use-module (gnu packages fonts) #:autoload (gnu packages guile-xyz) (guile-netlink) #:autoload (gnu packages hurd) (hurd) #:use-module (gnu packages package-management) @@ -103,6 +105,13 @@ console-font-service virtual-terminal-service-type + host + host? + host-address + host-canonical-name + host-aliases + hosts-service-type + static-networking static-networking? static-networking-addresses @@ -685,6 +694,72 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (rngd-configuration (rng-tools rng-tools) (device device)))) + +;;; +;;; /etc/hosts +;;; + +(define (valid-name? name) + "Return true if @var{name} is likely to be a valid host name." + (false-if-exception (not (string-any char-set:whitespace name)))) + +(define-compile-time-procedure (assert-valid-name (name valid-name?)) + "Ensure @var{name} is likely to be a valid host name." + ;; TODO: RFC compliant implementation. + (unless (valid-name? name) + (raise + (make-compound-condition + (formatted-message (G_ "host name '~a' contains invalid characters") + name) + (condition (&error-location + (location + (source-properties->location procedure-call-location))))))) + name) + +(define-record-type* <host> %host + ;; XXX: Using the record type constructor becomes tiresome when + ;; there's multiple records to make. + make-host host? + (address host-address) + (canonical-name host-canonical-name + (sanitize assert-valid-name)) + (aliases host-aliases + (default '()) + (sanitize (cut map assert-valid-name <>)))) + +(define* (host address canonical-name #:optional (aliases '())) + "Return a new record for the host at @var{address} with the given +@var{canonical-name} and possibly @var{aliases}. + +@var{address} must be a string denoting a valid IPv4 or IPv6 address, and +@var{canonical-name} and the strings listed in @var{aliases} must be valid +host names." + (%host + (address address) + (canonical-name canonical-name) + (aliases aliases))) + +(define hosts-service-type + ;; Extend etc-service-type with a entry for @file{/etc/hosts}. + (let* ((serialize-host-record + (lambda (record) + (match-record record <host> (address canonical-name aliases) + (format #f "~a~/~a~{~^~/~a~}~%" address canonical-name aliases)))) + (host-etc-service + (lambda (lst) + `(("hosts" ,(plain-file "hosts" + (format #f "~{~a~}" + (map serialize-host-record + lst)))))))) + (service-type + (name 'etc-hosts) + (extensions + (list + (service-extension etc-service-type + host-etc-service))) + (compose concatenate) + (extend append) + (description "Populate the @file{/etc/hosts} file.")))) ;;; @@ -749,10 +824,11 @@ to add @var{device} to the kernel's entropy pool. The service will fail if of console keymaps with @command{loadkeys}."))) (define %default-console-font - ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common - ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode - ;; codepoints notably found in the UTF-8 manual. - "LatGrkCyr-8x16") + ;; Note: the 'font-gnu-unifont' package cannot be cross-compiled (yet), but + ;; its "psf" output is the same whether it's built natively or not, hence + ;; 'ungexp-native'. + #~(string-append #+font-gnu-unifont:psf + "/share/consolefonts/Unifont-APL8x16.psf.gz")) (define (console-font-shepherd-services tty+font) "Return a list of Shepherd services for each pair in TTY+FONT." @@ -2502,7 +2578,7 @@ notably to select, copy, and paste text. The default options use the ;; TODO: Make this configurable. #:environment-variables (list (string-append "XDG_DATA_DIRS=" - #$font-gnu-unifont "/share")))) + #+font-gnu-unifont "/share")))) (stop #~(make-kill-destructor))))) (description "Start the @command{kmscon} virtual terminal emulator for the Linux @dfn{kernel mode setting} (KMS)."))) @@ -3071,6 +3147,7 @@ to handle." (default-session-command (greetd-default-session-command config))) (mixed-text-file config-file-name + "[general]\n" "source_profile = " (if source-profile? "true" "false") "\n" "[terminal]\n" "vt = " terminal-vt "\n" diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 6b0291dc00..02d1aa1796 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -34,6 +34,7 @@ #:autoload (texinfo) (texi-fragment->stexi) #:autoload (texinfo serialize) (stexi->texi) #:use-module (ice-9 curried-definitions) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) @@ -370,6 +371,8 @@ DEFAULT." (cond ((package? val) (symbol->string (package->symbol val))) + (((list-of package?) val) + (format #f "(~{~a~^ ~})" (map package->symbol val))) (else (str val)))) `(entry (% (heading diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index fe1f0fd20a..4724294433 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -3,10 +3,10 @@ ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com> -;;; Copyright © 2017, 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2017, 2020, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2017 Nikita <nikita@n0.is> ;;; Copyright © 2018, 2020, 2022 Efraim Flashner <efraim@flashner.co.il> -;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2018, 2023 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de> ;;; Copyright © 2019 David Wilson <david@daviwil.com> @@ -59,6 +59,7 @@ #:use-module (gnu packages xdisorg) #:use-module (gnu packages scanner) #:use-module (gnu packages suckless) + #:use-module (gnu packages sugar) #:use-module (gnu packages linux) #:use-module (gnu packages libusb) #:use-module (gnu packages lxqt) @@ -73,6 +74,7 @@ #:use-module (guix utils) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (<upower-configuration> @@ -143,6 +145,10 @@ lxqt-desktop-configuration? lxqt-desktop-service-type + sugar-desktop-configuration + sugar-desktop-configuration? + sugar-desktop-service-type + xfce-desktop-configuration xfce-desktop-configuration? xfce-desktop-service @@ -183,11 +189,19 @@ (define (bool value) (if value "true\n" "false\n")) -(define (package-direct-input-selector input) +(define (package-direct-input-selector tree) + "Return a procedure that selects TREE from the inputs of PACKAGE. If TREE +is a list, it recursively searches it until it locates the last item of TREE." (lambda (package) - (match (assoc-ref (package-direct-inputs package) input) - ((package . _) package)))) - + (let loop ((tree (if (pair? tree) + tree + (list tree))) + (package package)) + (if (null? tree) + package + (loop (cdr tree) + (car (assoc-ref (package-direct-inputs package) + (car tree)))))))) ;;; @@ -1339,28 +1353,44 @@ rules.") (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration make-gnome-desktop-configuration gnome-desktop-configuration? - (gnome gnome-package (default gnome))) + (gnome gnome-desktop-configuration-gnome + (default gnome))) -(define (gnome-packages config packages) - "Return the list of GNOME dependencies from CONFIG which names are part of -the given PACKAGES list." - (let ((gnome (gnome-package config))) - (map (lambda (name) - ((package-direct-input-selector name) gnome)) - packages))) +(define (gnome-package gnome name) + "Return the package NAME among the GNOME package inputs. NAME can be a +single name or a tree-like, e.g. @code{'(\"gnome-boxes\" \"spice-gtk\")} to +denote the spice-gtk input of the gnome-boxes input of the GNOME meta-package." + ((package-direct-input-selector name) gnome)) + +(define (gnome-packages gnome names) + "Return the package NAMES among the GNOME package inputs." + (map (cut gnome-package gnome <>) names)) (define (gnome-udev-rules config) "Return the list of GNOME dependencies that provide udev rules." - (gnome-packages config '("gnome-settings-daemon"))) + (let ((gnome (gnome-desktop-configuration-gnome config))) + (gnome-packages gnome '("gnome-settings-daemon")))) (define (gnome-polkit-settings config) "Return the list of GNOME dependencies that provide polkit actions and rules." - (gnome-packages config - '("gnome-settings-daemon" - "gnome-control-center" - "gnome-system-monitor" - "gvfs"))) + (let ((gnome (gnome-desktop-configuration-gnome config))) + (gnome-packages gnome + '("gnome-settings-daemon" + "gnome-control-center" + "gnome-system-monitor" + "gvfs" + ;; spice-gtk provides polkit actions for USB redirection + ;; in GNOME Boxes. + ("gnome-boxes" "spice-gtk"))))) + +(define (gnome-setuid-programs config) + "Return the list of GNOME setuid programs." + (let* ((gnome (gnome-desktop-configuration-gnome config)) + (spice-gtk (gnome-package gnome '("gnome-boxes" "spice-gtk")))) + (map file-like->setuid-program + (list (file-append spice-gtk + "/libexec/spice-client-glib-usb-acl-helper"))))) (define gnome-desktop-service-type (service-type @@ -1370,9 +1400,10 @@ rules." gnome-udev-rules) (service-extension polkit-service-type gnome-polkit-settings) + (service-extension setuid-program-service-type + gnome-setuid-programs) (service-extension profile-service-type - (compose list - gnome-package)))) + (compose list gnome-desktop-configuration-gnome)))) (default-value (gnome-desktop-configuration)) (description "Run the GNOME desktop environment."))) @@ -1493,6 +1524,38 @@ rules." ;;; +;;; Sugar desktop service. +;;; + +(define-record-type* <sugar-desktop-configuration> sugar-desktop-configuration + make-sugar-desktop-configuration + sugar-desktop-configuration? + (sugar sugar-package (default sugar)) + (gobject-introspection + sugar-gobject-introspection (default gobject-introspection)) + (activities + sugar-activities (default (list sugar-help-activity)))) + +(define (sugar-polkit-settings config) + "Return the list of packages that provide polkit actions and rules." + (list (sugar-package config))) + +(define sugar-desktop-service-type + (service-type + (name 'sugar-desktop) + (extensions + (list (service-extension polkit-service-type + sugar-polkit-settings) + (service-extension profile-service-type + (lambda (config) + (cons* (sugar-package config) + (sugar-gobject-introspection config) + (sugar-activities config)))))) + (default-value (sugar-desktop-configuration)) + (description "Run the Sugar desktop environment."))) + + +;;; ;;; X11 socket directory service ;;; diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm index 65bf0b5a7f..2dfedc553e 100644 --- a/gnu/services/guix.scm +++ b/gnu/services/guix.scm @@ -126,7 +126,18 @@ nar-herder-configuration-storage nar-herder-configuration-storage-limit nar-herder-configuration-storage-nar-removal-criteria - nar-herder-configuration-log-level)) + nar-herder-configuration-log-level + nar-herder-configuration-cached-compressions + nar-herder-configuration-cached-compression-min-uses + nar-herder-configuration-cached-compression-workers + nar-herder-configuration-cached-compression-nar-source + + nar-herder-cached-compression-configuration + nar-herder-cached-compression-configuration? + nar-herder-cached-compression-configuration-type + nar-herder-cached-compression-configuration-level + nar-herder-cached-compression-configuration-directory + nar-herder-cached-compression-configuration-directory-max-size)) ;;;; Commentary: ;;; @@ -828,17 +839,67 @@ ca-certificates.crt file in the system profile." (negative-ttl nar-herder-configuration-negative-ttl (default #f)) (log-level nar-herder-configuration-log-level - (default 'DEBUG))) + (default 'DEBUG)) + (cached-compressions + nar-herder-configuration-cached-compressions + (default '())) + (cached-compression-min-uses + nar-herder-configuration-cached-compression-min-uses + (default 3)) + (cached-compression-workers + nar-herder-configuration-cached-compression-workers + (default 2)) + (cached-compression-nar-source + nar-herder-configuration-cached-compression-nar-source + (default #f))) +(define-record-type* <nar-herder-cached-compression-configuration> + nar-herder-cached-compression-configuration + make-nar-herder-cached-compression-configuration + nar-herder-cached-compression-configuration? + (type nar-herder-cached-compression-configuration-type) + (level nar-herder-cached-compression-configuration-level + (default #f)) + (directory nar-herder-cached-compression-configuration-directory + (default #f)) + (directory-max-size + nar-herder-cached-compression-configuration-directory-max-size + (default #f))) (define (nar-herder-shepherd-services config) + (define (cached-compression-configuration->options cached-compression) + (match-record + cached-compression + <nar-herder-cached-compression-configuration> + (type level directory directory-max-size) + + `(,(simple-format #f "--enable-cached-compression=~A~A" + type + (if level + (simple-format #f ":~A" level) + "")) + ,@(if directory + (list + (simple-format #f "--cached-compression-directory=~A=~A" + type + directory)) + '()) + ,@(if directory-max-size + (list + (simple-format #f "--cached-compression-directory-max-size=~A=~A" + type + directory-max-size)) + '())))) + (match-record config <nar-herder-configuration> (package user group mirror database database-dump host port storage storage-limit storage-nar-removal-criteria - ttl negative-ttl log-level) + ttl negative-ttl log-level + cached-compressions cached-compression-min-uses + cached-compression-workers cached-compression-nar-source) (unless (or mirror storage) (error "nar-herder: mirror or storage must be set")) @@ -882,6 +943,24 @@ ca-certificates.crt file in the system profile." '()) #$@(if log-level (list (simple-format #f "--log-level=~A" log-level)) + '()) + #$@(append-map + cached-compression-configuration->options + cached-compressions) + #$@(if cached-compression-min-uses + (list (simple-format + #f "--cached-compression-min-uses=~A" + cached-compression-min-uses)) + '()) + #$@(if cached-compression-workers + (list (simple-format + #f "--cached-compression-workers=~A" + cached-compression-workers)) + '()) + #$@(if cached-compression-nar-source + (list (simple-format + #f "--cached-compression-nar-source=~A" + cached-compression-nar-source)) '())) #:user #$user #:group #$group diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm index 7e3864fec2..0b9094cda1 100644 --- a/gnu/services/lightdm.scm +++ b/gnu/services/lightdm.scm @@ -151,7 +151,7 @@ icon themes." "The name of the cursor theme to use.") (cursor-theme-size (number 16) - "The size to use for the the cursor theme.") + "The size to use for the cursor theme.") (allow-debugging? maybe-boolean "Set to #t to enable debug log level.") diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm index 44e2e8886c..bbf8b10f8b 100644 --- a/gnu/services/monitoring.scm +++ b/gnu/services/monitoring.scm @@ -662,9 +662,11 @@ $DB['PASSWORD'] = " (let ((file (location-file %location)) (string-append "trim(file_get_contents('" db-secret-file "'));\n")) (begin - (display-hint (format #f (G_ "~a:~a:~a: ~a: + (display-hint (G_ "~a:~a:~a: ~a: Consider using @code{db-secret-file} instead of @code{db-password} for better -security.") file line column 'zabbix-front-end-configuration)) +security.") + file line column + 'zabbix-front-end-configuration) (format #f "'~a';~%" db-password)))) " // Schema name. Used for IBM DB2 and PostgreSQL. diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 89ce16f6af..dacf64c2d1 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -20,6 +20,7 @@ ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2022, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2023 Declan Tsien <declantsien@riseup.net> +;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -80,7 +81,9 @@ #:use-module (json) #:re-export (static-networking-service static-networking-service-type) - #:export (%facebook-host-aliases + #:export (%facebook-host-aliases ;deprecated + block-facebook-hosts-service-type + dhcp-client-service-type dhcp-client-configuration dhcp-client-configuration? @@ -235,39 +238,36 @@ ;;; ;;; Code: -(define %facebook-host-aliases +(define facebook-host-aliases ;; This is the list of known Facebook hosts to be added to /etc/hosts if you ;; are to block it. - "\ -# Block Facebook IPv4. -127.0.0.1 www.facebook.com -127.0.0.1 facebook.com -127.0.0.1 login.facebook.com -127.0.0.1 www.login.facebook.com -127.0.0.1 fbcdn.net -127.0.0.1 www.fbcdn.net -127.0.0.1 fbcdn.com -127.0.0.1 www.fbcdn.com -127.0.0.1 static.ak.fbcdn.net -127.0.0.1 static.ak.connect.facebook.com -127.0.0.1 connect.facebook.net -127.0.0.1 www.connect.facebook.net -127.0.0.1 apps.facebook.com - -# Block Facebook IPv6. -fe80::1%lo0 facebook.com -fe80::1%lo0 login.facebook.com -fe80::1%lo0 www.login.facebook.com -fe80::1%lo0 fbcdn.net -fe80::1%lo0 www.fbcdn.net -fe80::1%lo0 fbcdn.com -fe80::1%lo0 www.fbcdn.com -fe80::1%lo0 static.ak.fbcdn.net -fe80::1%lo0 static.ak.connect.facebook.com -fe80::1%lo0 connect.facebook.net -fe80::1%lo0 www.connect.facebook.net -fe80::1%lo0 apps.facebook.com\n") - + (let ((domains '("facebook.com" "www.facebook.com" + "login.facebook.com" "www.login.facebook.com" + "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com" + "static.ak.fbcdn.net" "static.ak.connect.facebook.com" + "connect.facebook.net" "www.connect.facebook.net" + "apps.facebook.com"))) + (append-map (lambda (name) + (map (lambda (addr) + (host addr name)) + (list "127.0.0.1" "::1"))) domains))) + +(define-deprecated %facebook-host-aliases + block-facebook-hosts-service-type + (string-join + (map (lambda (x) + (string-append (host-address x) "\t" + (host-canonical-name x) "\n")) + facebook-host-aliases))) + +(define block-facebook-hosts-service-type + (service-type + (name 'block-facebook-hosts) + (extensions + (list (service-extension hosts-service-type + (const facebook-host-aliases)))) + (default-value #f) + (description "Add a list of known Facebook hosts to @file{/etc/hosts}"))) (define-record-type* <dhcp-client-configuration> dhcp-client-configuration make-dhcp-client-configuration diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm index b66c7a8563..23ccb8d403 100644 --- a/gnu/services/telephony.scm +++ b/gnu/services/telephony.scm @@ -267,7 +267,7 @@ consistent state.")) CONFIG, a <jami-configuration> object." (match-record config <jami-configuration> (libjami dbus enable-logging? debug? auto-answer?) - `(,(file-append libjami "/libexec/jamid") + `(,#~(string-append #$libjami:bin "/libexec/jamid") "--persistent" ;stay alive after client quits ,@(if enable-logging? '() ;logs go to syslog by default @@ -524,7 +524,8 @@ argument, either a registered username or the fingerprint of the account.") #:environment-variables ;; This is so that the cx.ring.Ring service D-Bus ;; definition is found by dbus-daemon. - (list (string-append "XDG_DATA_DIRS=" #$libjami "/share")))) + (list (string-append "XDG_DATA_DIRS=" + #$libjami:bin "/share")))) (stop #~(make-kill-destructor))) (shepherd-service @@ -595,7 +596,8 @@ argument, either a registered username or the fingerprint of the account.") ;; Start the daemon. (define daemon-pid ((make-forkexec-constructor/container - '#$(jami-configuration->command-line-arguments config) + (list #$@(jami-configuration->command-line-arguments + config)) #:mappings (list (file-system-mapping (source "/dev/log") ;for syslog |