From 9c6a461cf0512b8f43f83837907f35cf2255077e Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Tue, 1 May 2018 00:05:16 +0200 Subject: services: prosody: Add a description to the prosody-service-type. * gnu/services/messaging.scm (prosody-service-type)[description]: New field. --- gnu/services/messaging.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 80ffed0f2f..8ab1481f61 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -691,7 +691,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." (service-extension account-service-type (const %prosody-accounts)) (service-extension activation-service-type - prosody-activation))))) + prosody-activation))) + (description + "Run Prosody, a modern XMPP communication server."))) ;; A little helper to make it easier to document all those fields. (define (generate-documentation) -- cgit v1.2.3 From cb7c80f67de656025dee60785fb4b45ce2d7dacd Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Tue, 1 May 2018 00:14:31 +0200 Subject: services: prosody: Add a default value to the prosody-service-type. * gnu/services/messaging.scm (prosody-service-type)[default-value]: New field. --- gnu/services/messaging.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 8ab1481f61..273ba2cc14 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -692,6 +692,11 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." (const %prosody-accounts)) (service-extension activation-service-type prosody-activation))) + (default-value (prosody-configuration + (virtualhosts + (list + (virtualhost-configuration + (domain "localhost")))))) (description "Run Prosody, a modern XMPP communication server."))) -- cgit v1.2.3 From 8cd1e8e84926dc6ed1012a17609dea2d20ac41b4 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Sat, 28 Apr 2018 13:30:20 +0300 Subject: gnu: Add sound service. * gnu/services/sound.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add this. * doc/guix.texi (Sound Services): New chapter. --- doc/guix.texi | 44 ++++++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/sound.scm | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 131 insertions(+) create mode 100644 gnu/services/sound.scm (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 87892fc892..dc9894173e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -235,6 +235,7 @@ Services * X Window:: Graphical display. * Printing Services:: Local and remote printer support. * Desktop Services:: D-Bus and desktop services. +* Sound Services:: ALSA and Pulseaudio services. * Database Services:: SQL databases, key-value stores, etc. * Mail Services:: IMAP, POP3, SMTP, and all that. * Messaging Services:: Messaging services. @@ -9697,6 +9698,7 @@ declaration. * X Window:: Graphical display. * Printing Services:: Local and remote printer support. * Desktop Services:: D-Bus and desktop services. +* Sound Services:: ALSA and Pulseaudio services. * Database Services:: SQL databases, key-value stores, etc. * Mail Services:: IMAP, POP3, SMTP, and all that. * Messaging Services:: Messaging services. @@ -12842,6 +12844,48 @@ bluetooth keyboard or mouse. Users need to be in the @code{lp} group to access the D-Bus service. @end deffn +@node Sound Services +@subsubsection Sound Services + +@cindex sound support +@cindex ALSA +@cindex PulseAudio, sound support + +The @code{(gnu services sound)} module provides an +@code{alsa-service-type} service to generate an ALSA +@file{/etc/asound.conf} configuration file. This configuration file is +what allows applications that produce sound using ALSA to be correctly +handled. + +@deffn {Scheme Variable} alsa-service-type +This is the type for the @uref{https://alsa-project.org/, ALSA}, +@command{alsa-configuration} record as in this example: + +@example +(service alsa-service-type) +@end example + +See below for details about @code{alsa-configuration}. +@end deffn + +@deftp {Data Type} alsa-configuration +Data type representing the configuration for @code{alsa-service}. + +@table @asis +@item @code{pulseaudio?} (default: @var{#t}) +Whether ALSA applications should transparently be made to use the +@uref{http://www.pulseaudio.org/, PulseAudio} sound server. + +Using PulseAudio allows you to run several sound-producing applications +at the same time and to individual control them @i{via} +@command{pavucontrol}, among other things. + +@item @code{extra-options} (default: @var{""}) +String to append to the @file{asound.conf} file. + +@end table +@end deftp + @node Database Services @subsubsection Database Services diff --git a/gnu/local.mk b/gnu/local.mk index 39639ed506..cfe698d3ff 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -480,6 +480,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/networking.scm \ %D%/services/nfs.scm \ %D%/services/shepherd.scm \ + %D%/services/sound.scm \ %D%/services/herd.scm \ %D%/services/pm.scm \ %D%/services/rsync.scm \ diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm new file mode 100644 index 0000000000..5fe555e8b6 --- /dev/null +++ b/gnu/services/sound.scm @@ -0,0 +1,86 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Oleg Pykhalov +;;; +;;; 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 . + +(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 shadow) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (gnu packages pulseaudio) + #:use-module (ice-9 match) + #:export (alsa-configuration + alsa-service-type)) + +;;; Commentary: +;;; +;;; Sound services. +;;; +;;; Code: + + +;;; +;;; ALSA +;;; + +(define-record-type* + alsa-configuration make-alsa-configuration alsa-configuration? + (pulseaudio? alsa-configuration-pulseaudio? ;boolean + (default #t)) + (extra-options alsa-configuration-extra-options ;string + (default ""))) + +(define (alsa-config-file config) + "Return the ALSA configuration file corresponding to CONFIG." + (plain-file "asound.conf" + (string-append "# Generated by 'alsa-service'.\n\n" + (if (alsa-configuration-pulseaudio? config) + "# Use PulseAudio by default +pcm.!default { + type pulse + fallback \"sysdefault\" + hint { + show on + description \"Default ALSA Output (currently PulseAudio Sound Server)\" + } +} + +ctl.!default { + type pulse + fallback \"sysdefault\" +} +" + "") + (alsa-configuration-extra-options config)))) + +(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."))) + +;;; sound.scm ends here -- cgit v1.2.3 From 36d619e85d29d1fb2e4a36406c8bc6f999484f07 Mon Sep 17 00:00:00 2001 From: Pierre-Antoine Rouby Date: Thu, 10 May 2018 16:37:58 +0200 Subject: services: bitlbee: Add plugins. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Bitlbee Service): Add plugins. * gnu/services/messaging.scm (): Add plugins argument. (bitlbee-shepherd-service): Update config file. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 3 +++ gnu/services/messaging.scm | 13 +++++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 6aeb313773..637c9c3f4d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14985,6 +14985,9 @@ networking interface. @item @code{package} (default: @code{bitlbee}) The BitlBee package to use. +@item @code{plugins} (default: @code{'()}) +List of plugin packages to use---e.g., @code{bitlbee-discord}. + @item @code{extra-settings} (default: @code{""}) Configuration snippet added as-is to the BitlBee configuration file. @end table diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 273ba2cc14..4b7e724a78 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2015, 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Pierre-Antoine Rouby ;;; ;;; This file is part of GNU Guix. ;;; @@ -790,20 +791,24 @@ string, you could instantiate a prosody service like this: (default "127.0.0.1")) (port bitlbee-configuration-port (default 6667)) + (plugins bitlbee-plugins + (default '())) (extra-settings bitlbee-configuration-extra-settings (default ""))) (define bitlbee-shepherd-service (match-lambda - (($ bitlbee interface port extra-settings) - (let ((conf (plain-file "bitlbee.conf" - (string-append " + (($ bitlbee interface port + plugins extra-settings) + (let ((conf (mixed-text-file "bitlbee.conf" + " [settings] User = bitlbee ConfigDir = /var/lib/bitlbee DaemonInterface = " interface " DaemonPort = " (number->string port) " -" extra-settings)))) + PluginDir = " (directory-union "bitlbee-plugins" plugins) "/lib/bitlbee +" extra-settings))) (with-imported-modules (source-module-closure '((gnu build shepherd) -- cgit v1.2.3 From ef6a484475e7473131efd9a41473c1f25a6b0d0c Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Wed, 2 May 2018 15:01:37 +0300 Subject: services: desktop: Add alsa-service-type. * gnu/services/desktop.scm (%desktop-services): Add 'alsa-service-type'. --- gnu/services/desktop.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 517d5d3efe..0dada82738 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -29,6 +29,7 @@ #:use-module (gnu services avahi) #:use-module (gnu services xorg) #:use-module (gnu services networking) + #:use-module (gnu services sound) #:use-module ((gnu system file-systems) #:select (%elogind-file-systems)) #:use-module (gnu system shadow) @@ -934,6 +935,8 @@ with the administrator's password." x11-socket-directory-service + (service alsa-service-type) + %base-services)) ;;; desktop.scm ends here -- cgit v1.2.3 From f93c7a89797667db073b1ddbb0fbbea41f16bf33 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Mon, 14 May 2018 20:14:10 +0530 Subject: gnu: services: Fix wesnothd-configuration? symbol export. * gnu/services/games.scm: Export wesnothd-configuration?, not the non-existent wesnoth-configuration?. --- gnu/services/games.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/games.scm b/gnu/services/games.scm index b146696237..b9d78e078d 100644 --- a/gnu/services/games.scm +++ b/gnu/services/games.scm @@ -27,7 +27,7 @@ #:use-module (guix records) #:use-module (ice-9 match) #:export (wesnothd-configuration - wesnoth-configuration? + wesnothd-configuration? wesnothd-service-type)) ;;; -- cgit v1.2.3 From c3343d62f682b33b1eefce74e9b08585faa8680c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 25 Apr 2018 08:17:52 +0100 Subject: services: cgit: Improve handling of extra-options. * gnu/services/cgit.scm (serialize-cgit-configuration): Add the extra options, one per line, before the scan-path, as this makes it possible to use the extra-options to affect the global behaviour for repositories. (serialize-extra-options): New procedure. --- gnu/services/cgit.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm index 8ef12cd5a0..3183535d4a 100644 --- a/gnu/services/cgit.scm +++ b/gnu/services/cgit.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2018 Clément Lassieur +;;; Copyright © 2018 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -169,6 +170,9 @@ 'project-list (plain-file "project-list" (string-join val "\n"))))) +(define (serialize-extra-options extra-options) + (string-join extra-options "\n" 'suffix)) + (define repository-directory? string?) (define (serialize-repository-directory _ val) @@ -641,6 +645,7 @@ for cgit to allow access to that repository.") (define (rest? field) (not (memq (configuration-field-name field) '(project-list + extra-options repository-directory repositories)))) #~(string-append @@ -649,6 +654,8 @@ for cgit to allow access to that repository.") #$(serialize-project-list 'project-list (cgit-configuration-project-list config)) + #$(serialize-extra-options + (cgit-configuration-extra-options config)) #$(serialize-repository-directory 'repository-directory (cgit-configuration-repository-directory config)) -- cgit v1.2.3 From 6ee3f3dec72f87187226bc11ff190f030169e55a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 25 Apr 2018 08:18:38 +0100 Subject: services: cgit: Make project-list permit a file-object. Instead of having the service manage the list, it's useful to be able to point this at an existing file, for example, when using cgit together with gitolite. * gnu/services/cgit.scm (project-list?): New procedure. (serialize-project-list): Handle file-object values. (): Change the predicate for project-list to allow lists and file-objects. --- doc/guix.texi | 2 +- gnu/services/cgit.scm | 10 ++++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 005c0597ad..81ad4f48f1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -19241,7 +19241,7 @@ Defaults to @samp{#f}. @end deftypevr -@deftypevr {@code{cgit-configuration} parameter} list project-list +@deftypevr {@code{cgit-configuration} parameter} project-list project-list A list of subdirectories inside of @code{repository-directory}, relative to it, that should loaded as Git repositories. An empty list means that all subdirectories will be loaded. diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm index 3183535d4a..3289d37333 100644 --- a/gnu/services/cgit.scm +++ b/gnu/services/cgit.scm @@ -116,6 +116,10 @@ (define (serialize-file-object field-name val) (serialize-string field-name val)) +(define (project-list? val) + (or (list? val) + (file-object? val))) + ;;; ;;; Serialize @@ -168,7 +172,9 @@ (if (null? val) "" (serialize-field 'project-list - (plain-file "project-list" (string-join val "\n"))))) + (if (file-object? val) + val + (plain-file "project-list" (string-join val "\n")))))) (define (serialize-extra-options extra-options) (string-join extra-options "\n" 'suffix)) @@ -547,7 +553,7 @@ disabled.") "Flag which, when set to @samp{#t}, will make cgit omit the standard header on all pages.") (project-list - (list '()) + (project-list '()) "A list of subdirectories inside of @code{repository-directory}, relative to it, that should loaded as Git repositories. An empty list means that all subdirectories will be loaded.") -- cgit v1.2.3 From e9d271ed9a1fba86f372986a137b6110a41a1324 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Sat, 10 Mar 2018 22:24:00 +0200 Subject: services: Add Enlightenment desktop service. * gnu/services/desktop.scm (, enlightenment-desktop-service-type): New variables. * doc/guix.texi (Desktop Services): Document the service. * NEWS: Mention it. --- NEWS | 7 ++++++ doc/guix.texi | 27 ++++++++++++++++----- gnu/services/desktop.scm | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 90 insertions(+), 6 deletions(-) (limited to 'gnu/services') diff --git a/NEWS b/NEWS index ca57f5d1fc..6003b5d577 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,13 @@ Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès Please send Guix bug reports to bug-guix@gnu.org. * Changes in 0.15.0 (since 0.14.0) + +** Distribution + +*** New services + +enlightenment + ** Programming interfaces *** package-full-name (guix packages) now uses "@" as its delimiter. diff --git a/doc/guix.texi b/doc/guix.texi index 81ad4f48f1..5129b998bd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12678,11 +12678,11 @@ field of an @code{operating-system} declaration (@pxref{operating-system Reference, @code{services}}). Additionally, the @code{gnome-desktop-service}, -@code{xfce-desktop-service} and @code{mate-desktop-service} -procedures can add GNOME, XFCE and/or MATE to a system. -To ``add GNOME'' means that system-level services like the -backlight adjustment helpers and the power management utilities are -added to the system, extending @code{polkit} and @code{dbus} +@code{xfce-desktop-service}, @code{mate-desktop-service} and +@code{enlightenment-desktop-service-type} procedures can add GNOME, XFCE, MATE +and/or Enlightenment to a system. To ``add GNOME'' means that system-level +services like the backlight adjustment helpers and the power management +utilities are added to the system, extending @code{polkit} and @code{dbus} appropriately, allowing GNOME to operate with elevated privileges on a limited number of special-purpose system interfaces. Additionally, adding a service made by @code{gnome-desktop-service} adds the GNOME @@ -12695,7 +12695,10 @@ To ``add MATE'' means that @code{polkit} and @code{dbus} are extended appropriately, allowing MATE to operate with elevated privileges on a limited number of special-purpose system interfaces. Additionally, adding a service made by @code{mate-desktop-service} adds the MATE -metapackage to the system profile. +metapackage to the system profile. ``Adding ENLIGHTENMENT'' means that +@code{dbus} is extended appropriately, and several of Enlightenment's binaries +are set as setuid, allowing Enlightenment's screen locker and other +functionality to work as expetected. The desktop environments in Guix use the Xorg display server by default. If you'd like to use the newer display server protocol @@ -12725,6 +12728,18 @@ profile, and extends polkit with the actions from @code{mate-settings-daemon}. @end deffn +@deffn {Scheme Procedure} enlightenment-desktop-service-type +Return a service that adds the @code{enlightenment} package to the system +profile, and extends dbus with actions from @code{efl}. +@end deffn + +@deftp {Data Type} enlightenment-desktop-service-configuration +@table @asis +@item @code{enlightenment} (default @code{enlightenment}) +The enlightenment package to use. +@end table +@end deftp + Because the GNOME, XFCE and MATE desktop services pull in so many packages, the default @code{%desktop-services} variable doesn't include any of them by default. To add GNOME, XFCE or MATE, just @code{cons} them onto diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 0dada82738..a9af7246f5 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2016 Sou Bunnbu ;;; Copyright © 2017 Maxim Cournoyer ;;; Copyright © 2017 Nils Gillmann +;;; Copyright © 2018 Efraim Flashner ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module (gnu services sound) #:use-module ((gnu system file-systems) #:select (%elogind-file-systems)) + #:use-module (gnu system) #:use-module (gnu system shadow) #:use-module (gnu system pam) #:use-module (gnu packages glib) @@ -45,9 +47,11 @@ #:use-module (gnu packages linux) #:use-module (gnu packages libusb) #:use-module (gnu packages mate) + #:use-module (gnu packages enlightenment) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix store) + #:use-module (guix utils) #:use-module (guix gexp) #:use-module (srfi srfi-1) #:use-module (ice-9 match) @@ -97,6 +101,10 @@ x11-socket-directory-service + enlightenment-desktop-configuration + enlightenment-desktop-configuration? + enlightenment-desktop-service-type + %desktop-services)) ;;; Commentary: @@ -900,6 +908,60 @@ with the administrator's password." (let ((directory "/tmp/.X11-unix")) (mkdir-p directory) (chmod directory #o777)))))) + +;;; +;;; Enlightenment desktop service. +;;; + +(define-record-type* + enlightenment-desktop-configuration make-enlightenment-desktop-configuration + enlightenment-desktop-configuration? + ;; + (enlightenment enlightenment-package + (default enlightenment))) + +(define (enlightenment-setuid-programs enlightenment-desktop-configuration) + (match-record enlightenment-desktop-configuration + + (enlightenment) + (list (file-append enlightenment + "/lib/enlightenment/utils/enlightenment_sys") + (file-append enlightenment + "/lib/enlightenment/utils/enlightenment_backlight") + ;; TODO: Move this binary to a screen-locker service. + (file-append enlightenment + "/lib/enlightenment/utils/enlightenment_ckpasswd") + (file-append enlightenment + (string-append + "/lib/enlightenment/modules/cpufreq/" + (match (string-tokenize (%current-system) + (char-set-complement (char-set #\-))) + ((arch "linux") (string-append "linux-gnu-" arch)) + ((arch "gnu") (string-append "gnu-" arch))) + "-" + (version-major+minor (package-version enlightenment)) + "/freqset"))))) + +(define enlightenment-desktop-service-type + (service-type + (name 'enlightenment-desktop) + (extensions + (list (service-extension dbus-root-service-type + (compose list + (package-direct-input-selector + "efl") + enlightenment-package)) + (service-extension setuid-program-service-type + enlightenment-setuid-programs) + (service-extension profile-service-type + (compose list + enlightenment-package)))) + (default-value (enlightenment-desktop-configuration)) + (description + "Return a service that adds the @code{enlightenment} package to the system +profile, and extends dbus with the ability for @code{efl} to generate +thumbnails and makes setuid the programs which enlightenment needs to function +as expected."))) ;;; -- cgit v1.2.3 From 9b0e51461d8170aaa5147fca33647371e8a8eb12 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 17 May 2018 21:15:46 +0300 Subject: services: connman: Add default configuration to the connman-service-type. * gnu/services/networking.scm (connman-service-type)[default-value]: New field. --- gnu/services/networking.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 0c9c69eef5..6e71ccf8fe 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -959,6 +959,7 @@ wireless networking.")))) ;; Add connman to the system profile. (service-extension profile-service-type connman-package))) + (default-value (connman-configuration)) (description "Run @url{https://01.org/connman,Connman}, a network connection manager.")))) -- cgit v1.2.3 From 6a2b906565b677d62210d69d418ce150c202931b Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Fri, 18 May 2018 18:23:39 +0300 Subject: services: dbus: Search more directories for '.service' files. * gnu/services/dbus.scm (system-service-directory): Remove one level of directories when searching for '.service' files. --- gnu/services/dbus.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 360a8af9ab..1e24d93ccb 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -63,7 +63,7 @@ all the services that may be activated by the daemon." (find-files (string-append service - "/share/dbus-1/system-services") + "/share/dbus-1/") "\\.service$")) (list #$@services))) -- cgit v1.2.3 From 19f20f4ffe88eb0ea3b0c88d1cf3ec43cda926c5 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Fri, 18 May 2018 18:25:07 +0300 Subject: services: openntpd: Add openntpd to the system profile. * gnu/services/networking.scm (openntpd-service-type): Extend the profile-service-type and add openntpd to the system profile. --- gnu/services/networking.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 6e71ccf8fe..a24342f237 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -464,6 +464,8 @@ make an initial adjustment of more than 1,000 seconds." openntpd-shepherd-service) (service-extension account-service-type (const %ntp-accounts)) + (service-extension profile-service-type + (compose list openntpd-configuration-openntpd)) (service-extension activation-service-type openntpd-service-activation))) (default-value (openntpd-configuration)) -- cgit v1.2.3 From d8ac79870132a00529825a09d73ad5cb7d2347bd Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Fri, 18 May 2018 18:26:03 +0300 Subject: services: connman: Add polkit hooks for connman. * gnu/services/networking.scm (connman-service-type): Extend the polkit-service-type with actions from connman. --- gnu/services/networking.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index a24342f237..e4441f6475 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -954,6 +954,8 @@ wireless networking.")))) (extensions (list (service-extension shepherd-root-service-type connman-shepherd-service) + (service-extension polkit-service-type + connman-package) (service-extension dbus-root-service-type connman-package) (service-extension activation-service-type -- cgit v1.2.3 From d1ae68796791a1d34a09f34dd8455a9b1bdaf64c Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 24 May 2018 10:15:27 +0200 Subject: gnu: gnome-desktop-service-type: Add description. * gnu/services/desktop.scm (gnome-desktop-service-type): Add description. --- gnu/services/desktop.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index a9af7246f5..add3c30a6e 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2017 Maxim Cournoyer ;;; Copyright © 2017 Nils Gillmann ;;; Copyright © 2018 Efraim Flashner +;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -828,7 +829,8 @@ rules." gnome-polkit-settings) (service-extension profile-service-type (compose list - gnome-package)))))) + gnome-package)))) + (description "Run the GNOME desktop environment."))) (define* (gnome-desktop-service #:key (config (gnome-desktop-configuration))) "Return a service that adds the @code{gnome} package to the system profile, -- cgit v1.2.3 From a31d7334c25befef5b48e1ab6859e919176a0c77 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 24 May 2018 10:15:51 +0200 Subject: gnu: mate-desktop-service-type: Add description. * gnu/services/desktop.scm (mate-desktop-service-type): Add description. --- gnu/services/desktop.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index add3c30a6e..1e8c02c02a 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -856,7 +856,8 @@ and extends polkit with the actions from @code{gnome-settings-daemon}." mate-package)) (service-extension profile-service-type (compose list - mate-package)))))) + mate-package)))) + (description "Run the MATE desktop environment."))) (define* (mate-desktop-service #:key (config (mate-desktop-configuration))) "Return a service that adds the @code{mate} package to the system profile, -- cgit v1.2.3 From a5acc17a3c10a3779b5b8b1a2565ef130be77e51 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 18 May 2018 13:43:07 +0200 Subject: file-systems: Remove 'title' field and add . The 'title' field was easily overlooked and was an endless source of confusion. Now, the value of the 'device' field is self-contained. * gnu/system/file-systems.scm (): Change constructor name to '%file-system'. [title]: Remove. (): New record type with printer. (report-deprecation, device-expression) (process-file-system-declaration, file-system): New macros. (file-system-title): New procedure. (file-system->spec, spec->file-system): Adjust to handle . * gnu/system.scm (bootable-kernel-arguments): Add case for 'file-system-label?'. (read-boot-parameters): Likewise. (mapped-device-user): Avoid 'file-system-title'. (fs->boot-device): Remove. (operating-system-boot-parameters): Use 'file-system-device' instead of 'fs->boot-device'. (device->sexp): Add case for 'file-system-label?'. * gnu/bootloader/grub.scm (grub-root-search): Add case for 'file-system-label?'. * gnu/system/examples/bare-bones.tmpl, gnu/system/examples/beaglebone-black.tmpl, gnu/system/examples/lightweight-desktop.tmpl, gnu/system/examples/vm-image.tmpl: Remove uses of 'title'. * gnu/system/vm.scm (virtualized-operating-system): Remove uses of 'file-system-title'. * guix/scripts/system.scm (check-file-system-availability): Likewise, and adjust fix-it hint. (check-initrd-modules)[file-system-/dev]: Likewise. * gnu/build/file-systems.scm (canonicalize-device-spec): Remove 'title' parameter. [canonical-title]: Remove. Match on SPEC's type rather than on CANONICAL-TITLE. (mount-file-system): Adjust caller. * gnu/build/linux-boot.scm (boot-system): Interpret ROOT here. * gnu/services/base.scm (file-system->fstab-entry): Remove use of 'file-system-title'. * doc/guix.texi (File Systems): Remove documentation of the 'title' field. Rewrite documentation of 'device' and document 'file-system-label'. --- doc/guix.texi | 48 ++++++------ gnu/bootloader/grub.scm | 10 ++- gnu/build/file-systems.scm | 54 ++++---------- gnu/build/linux-boot.scm | 12 ++- gnu/services/base.scm | 17 ++--- gnu/system.scm | 38 +++++----- gnu/system/examples/bare-bones.tmpl | 3 +- gnu/system/examples/beaglebone-black.tmpl | 3 +- gnu/system/examples/lightweight-desktop.tmpl | 4 +- gnu/system/examples/vm-image.tmpl | 3 +- gnu/system/file-systems.scm | 108 ++++++++++++++++++++++++--- gnu/system/vm.scm | 5 +- guix/scripts/system.scm | 31 ++++---- 13 files changed, 202 insertions(+), 134 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 5129b998bd..5eee40fc3c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9210,20 +9210,31 @@ This is a string specifying the type of the file system---e.g., This designates the place where the file system is to be mounted. @item @code{device} -This names the ``source'' of the file system. By default it is the name -of a node under @file{/dev}, but its meaning depends on the @code{title} -field described below. +This names the ``source'' of the file system. It can be one of three +things: a file system label, a file system UUID, or the name of a +@file{/dev} node. Labels and UUIDs offer a way to refer to file +systems without having to hard-code their actual device +name@footnote{Note that, while it is tempting to use +@file{/dev/disk/by-uuid} and similar device names to achieve the same +result, this is not recommended: These special device nodes are created +by the udev daemon and may be unavailable at the time the device is +mounted.}. -@item @code{title} (default: @code{'device}) -This is a symbol that specifies how the @code{device} field is to be -interpreted. +@findex file-system-label +File system labels are created using the @code{file-system-label} +procedure, UUIDs are created using @code{uuid}, and @file{/dev} node are +plain strings. Here's an example of a file system referred to by its +label, as shown by the @command{e2label} command: -When it is the symbol @code{device}, then the @code{device} field is -interpreted as a file name; when it is @code{label}, then @code{device} -is interpreted as a file system label name; when it is @code{uuid}, -@code{device} is interpreted as a file system unique identifier (UUID). +@example +(file-system + (mount-point "/home") + (type "ext4") + (device (file-system-label "my-home"))) +@end example -UUIDs may be converted from their string representation (as shown by the +@findex uuid +UUIDs are converted from their string representation (as shown by the @command{tune2fs -l} command) using the @code{uuid} form@footnote{The @code{uuid} form expects 16-byte UUIDs as defined in @uref{https://tools.ietf.org/html/rfc4122, RFC@tie{}4122}. This is the @@ -9235,22 +9246,13 @@ like this: (file-system (mount-point "/home") (type "ext4") - (title 'uuid) (device (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) @end example -The @code{label} and @code{uuid} options offer a way to refer to file -systems without having to hard-code their actual device -name@footnote{Note that, while it is tempting to use -@file{/dev/disk/by-uuid} and similar device names to achieve the same -result, this is not recommended: These special device nodes are created -by the udev daemon and may be unavailable at the time the device is -mounted.}. - -However, when the source of a file system is a mapped device (@pxref{Mapped +When the source of a file system is a mapped device (@pxref{Mapped Devices}), its @code{device} field @emph{must} refer to the mapped -device name---e.g., @file{/dev/mapper/root-partition}---and consequently -@code{title} must be set to @code{'device}. This is required so that +device name---e.g., @file{"/dev/mapper/root-partition"}. +This is required so that the system knows that mounting the file system depends on having the corresponding device mapping established. diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm index 3b01125c78..eca6d97b19 100644 --- a/gnu/bootloader/grub.scm +++ b/gnu/bootloader/grub.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; Copyright © 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe @@ -31,6 +31,7 @@ #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system uuid) + #:use-module (gnu system file-systems) #:autoload (gnu packages bootloaders) (grub) #:autoload (gnu packages compression) (gzip) #:autoload (gnu packages gtk) (guile-cairo guile-rsvg) @@ -303,9 +304,10 @@ code." ((? uuid? uuid) (format #f "search --fs-uuid --set ~a" (uuid->string device))) - ((? string? label) - (format #f "search --label --set ~a" label)) - (#f + ((? file-system-label? label) + (format #f "search --label --set ~a" + (file-system-label->string label))) + ((or #f (? string?)) #~(format #f "search --file --set ~a" #$file))))) (define* (grub-configuration-file config entries diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 145b3b14e7..3dd7358fd3 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2016, 2017 David Craven ;;; Copyright © 2017 Mathieu Othacehe ;;; @@ -473,17 +473,9 @@ were found." (find-partition luks-partition-uuid-predicate)) -(define* (canonicalize-device-spec spec #:optional (title 'any)) - "Return the device name corresponding to SPEC. TITLE is a symbol, one of -the following: - - • 'device', in which case SPEC is known to designate a device node--e.g., - \"/dev/sda1\"; - • 'label', in which case SPEC is known to designate a partition label--e.g., - \"my-root-part\"; - • 'uuid', in which case SPEC must be a UUID designating a partition; - • 'any', in which case SPEC can be anything. -" +(define (canonicalize-device-spec spec) + "Return the device name corresponding to SPEC, which can be a , a +, or a string (typically a /dev file name)." (define max-trials ;; Number of times we retry partition label resolution, 1 second per ;; trial. Note: somebody reported a delay of 16 seconds (!) before their @@ -491,19 +483,6 @@ the following: ;; this long. 20) - (define canonical-title - ;; The realm of canonicalization. - (if (eq? title 'any) - (if (string? spec) - ;; The "--root=SPEC" kernel command-line option always provides a - ;; string, but the string can represent a device, a UUID, or a - ;; label. So check for all three. - (cond ((string-prefix? "/" spec) 'device) - ((string->uuid spec) 'uuid) - (else 'label)) - 'uuid) - title)) - (define (resolve find-partition spec fmt) (let loop ((count 0)) (let ((device (find-partition spec))) @@ -518,23 +497,19 @@ the following: (sleep 1) (loop (+ 1 count)))))))) - (case canonical-title - ((device) + (match spec + ((? string?) ;; Nothing to do. spec) - ((label) + ((? file-system-label?) ;; Resolve the label. - (resolve find-partition-by-label spec identity)) - ((uuid) + (resolve find-partition-by-label + (file-system-label->string spec) + identity)) + ((? uuid?) (resolve find-partition-by-uuid - (cond ((string? spec) - (string->uuid spec)) - ((uuid? spec) - (uuid-bytevector spec)) - (else spec)) - uuid->string)) - (else - (error "unknown device title" title)))) + (uuid-bytevector spec) + uuid->string)))) (define (check-file-system device type) "Run a file system check of TYPE on DEVICE." @@ -615,8 +590,7 @@ run a file system check." ""))))) (let ((type (file-system-type fs)) (options (file-system-options fs)) - (source (canonicalize-device-spec (file-system-device fs) - (file-system-title fs))) + (source (canonicalize-device-spec (file-system-device fs))) (mount-point (string-append root "/" (file-system-mount-point fs))) (flags (mount-flags->bit-mask (file-system-flags fs)))) diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index 18d87260a9..44b3506284 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -507,9 +507,15 @@ upon error." (error "pre-mount actions failed"))) (if root - (mount-root-file-system (canonicalize-device-spec root) - root-fs-type - #:volatile-root? volatile-root?) + ;; The "--root=SPEC" kernel command-line option always provides a + ;; string, but the string can represent a device, a UUID, or a + ;; label. So check for all three. + (let ((root (cond ((string-prefix? "/" root) root) + ((uuid root) => identity) + (else (file-system-label root))))) + (mount-root-file-system (canonicalize-device-spec root) + root-fs-type + #:volatile-root? volatile-root?)) (mount "none" "/root" "tmpfs")) ;; Mount the specified file systems. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index eb82b2ddcf..09a1ce95e3 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -303,15 +303,14 @@ seconds after @code{SIGTERM} has been sent are terminated with (define (file-system->fstab-entry file-system) "Return a @file{/etc/fstab} entry for @var{file-system}." - (string-append (case (file-system-title file-system) - ((label) - (string-append "LABEL=" (file-system-device file-system))) - ((uuid) - (string-append - "UUID=" - (uuid->string (file-system-device file-system)))) - (else - (file-system-device file-system))) + (string-append (match (file-system-device file-system) + ((? file-system-label? label) + (string-append "LABEL=" + (file-system-label->string file-system))) + ((? uuid? uuid) + (string-append "UUID=" (uuid->string uuid))) + ((? string? device) + device)) "\t" (file-system-mount-point file-system) "\t" (file-system-type file-system) "\t" diff --git a/gnu/system.scm b/gnu/system.scm index 1052e9355d..288c1e8801 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -131,13 +131,16 @@ "Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be booted from ROOT-DEVICE" (cons* (string-append "--root=" - (if (uuid? root-device) - - ;; Note: Always use the DCE format because that's - ;; what (gnu build linux-boot) expects for the - ;; '--root' kernel command-line option. - (uuid->string (uuid-bytevector root-device) 'dce) - root-device)) + (cond ((uuid? root-device) + + ;; Note: Always use the DCE format because that's + ;; what (gnu build linux-boot) expects for the + ;; '--root' kernel command-line option. + (uuid->string (uuid-bytevector root-device) + 'dce)) + ((file-system-label? root-device) + (file-system-label->string root-device)) + (else root-device))) #~(string-append "--system=" #$system.drv) #~(string-append "--load=" #$system.drv "/boot") kernel-arguments)) @@ -251,10 +254,16 @@ file system labels." (match-lambda (('uuid (? symbol? type) (? bytevector? bv)) (bytevector->uuid bv type)) + (('file-system-label (? string? label)) + (file-system-label label)) ((? bytevector? bv) ;old format (bytevector->uuid bv 'dce)) ((? string? device) - device))) + ;; It used to be that we would not distinguish between labels and + ;; device names. Try to infer the right thing here. + (if (string-prefix? "/dev/" device) + device + (file-system-label device))))) (match (read port) (('boot-parameters ('version 0) @@ -377,7 +386,7 @@ marked as 'needed-for-boot'." (let ((target (string-append "/dev/mapper/" (mapped-device-target device)))) (find (lambda (fs) (or (member device (file-system-dependencies fs)) - (and (eq? 'device (file-system-title fs)) + (and (string? (file-system-device fs)) (string=? (file-system-device fs) target)))) file-systems))) @@ -934,13 +943,6 @@ listed in OS. The C library expects to find it under (bootloader-configuration-bootloader bootloader-conf)) bootloader-conf (list entry) #:old-entries old-entries))) -(define (fs->boot-device fs) - "Given FS, a object, return a value suitable for use as the -device in a ." - (case (file-system-title fs) - ((uuid label device) (file-system-device fs)) - (else #f))) - (define (operating-system-boot-parameters os system.drv root-device) "Return a monadic record that describes the boot parameters of OS. SYSTEM.DRV is either a derivation or #f. If it's a derivation, adds @@ -962,7 +964,7 @@ kernel arguments for that derivation to ." (operating-system-user-kernel-arguments os))) (initrd initrd) (bootloader-name bootloader-name) - (store-device (ensure-not-/dev (fs->boot-device store))) + (store-device (ensure-not-/dev (file-system-device store))) (store-mount-point (file-system-mount-point store)))))) (define (device->sexp device) @@ -970,6 +972,8 @@ kernel arguments for that derivation to ." (match device ((? uuid? uuid) `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid))) + ((? file-system-label? label) + `(file-system-label ,(file-system-label->string label))) (_ device))) diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index 7e0c8fbee0..cb6d2623db 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -16,8 +16,7 @@ (bootloader grub-bootloader) (target "/dev/sdX"))) (file-systems (cons (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl index 97201330c7..d1130c76b6 100644 --- a/gnu/system/examples/beaglebone-black.tmpl +++ b/gnu/system/examples/beaglebone-black.tmpl @@ -20,8 +20,7 @@ (initrd-modules (cons "omap_hsmmc" %base-initrd-modules)) (file-systems (cons (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl index 65a8ee1809..360ee62ffe 100644 --- a/gnu/system/examples/lightweight-desktop.tmpl +++ b/gnu/system/examples/lightweight-desktop.tmpl @@ -20,13 +20,11 @@ ;; Assume the target root file system is labelled "my-root", ;; and the EFI System Partition has UUID 1234-ABCD. (file-systems (cons* (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) (file-system (device (uuid "1234-ABCD" 'fat)) - (title 'uuid) (mount-point "/boot/efi") (type "vfat")) %base-file-systems)) diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl index ce3653c8b4..36e272722d 100644 --- a/gnu/system/examples/vm-image.tmpl +++ b/gnu/system/examples/vm-image.tmpl @@ -31,8 +31,7 @@ partprobe, and then 2) resizing the filesystem with resize2fs.\n")) (target "/dev/sda") (terminal-outputs '(console)))) (file-systems (cons (file-system - (device "my-root") - (title 'label) + (device (file-system-label "my-root")) (mount-point "/") (type "ext4")) %base-file-systems)) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 93289dbd5d..2b5948256a 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -20,6 +20,8 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (guix records) #:use-module (gnu system uuid) #:re-export (uuid ;backward compatibility @@ -28,7 +30,7 @@ #:export (file-system file-system? file-system-device - file-system-title + file-system-title ;deprecated file-system-mount-point file-system-type file-system-needed-for-boot? @@ -42,6 +44,10 @@ file-system-type-predicate + file-system-label + file-system-label? + file-system-label->string + file-system->spec spec->file-system specification->file-system-mapping @@ -82,12 +88,10 @@ ;;; Code: ;; File system declaration. -(define-record-type* file-system +(define-record-type* %file-system make-file-system file-system? - (device file-system-device) ; string - (title file-system-title ; 'device | 'label | 'uuid - (default 'device)) + (device file-system-device) ; string | | (mount-point file-system-mount-point) ; string (type file-system-type) ; string (flags file-system-flags ; list of symbols @@ -108,6 +112,83 @@ (default (current-source-location)) (innate))) +;; A file system label for use in the 'device' field. +(define-record-type + (file-system-label label) + file-system-label? + (label file-system-label->string)) + +(set-record-type-printer! + (lambda (obj port) + (format port "#" + (file-system-label->string obj)))) + +(define-syntax report-deprecation + (lambda (s) + "Report the use of the now-deprecated 'title' field." + (syntax-case s () + ((_ field) + (let* ((source (syntax-source #'field)) + (file (and source (assq-ref source 'filename))) + (line (and source + (and=> (assq-ref source 'line) 1+))) + (column (and source (assq-ref source 'column)))) + (format (current-error-port) + "~a:~a:~a: warning: 'title' field is deprecated~%" + file line column) + #t))))) + +;; Helper for 'process-file-system-declaration'. +(define-syntax device-expression + (syntax-rules (quote label uuid device) + ((_ (quote label) dev) + (file-system-label dev)) + ((_ (quote uuid) dev) + (if (uuid? dev) dev (uuid dev))) + ((_ (quote device) dev) + dev) + ((_ title dev) + (case title + ((label) (file-system-label dev)) + ((uuid) (uuid dev)) + (else dev))))) + +;; Helper to interpret the now-deprecated 'title' field. Detect forms like +;; (title 'label), remove them, and adjust the 'device' field accordingly. +;; TODO: Remove this once 'title' has been deprecated long enough. +(define-syntax process-file-system-declaration + (syntax-rules (device title) + ((_ () (rest ...) #f #f) ;no 'title' and no 'device' field + (%file-system rest ...)) + ((_ () (rest ...) dev #f) ;no 'title' field + (%file-system rest ... (device dev))) + ((_ () (rest ...) dev titl) ;got a 'title' field + (%file-system rest ... + (device (device-expression titl dev)))) + ((_ ((title titl) rest ...) (previous ...) dev _) + (begin + (report-deprecation (title titl)) + (process-file-system-declaration (rest ...) + (previous ...) + dev titl))) + ((_ ((device dev) rest ...) (previous ...) _ titl) + (process-file-system-declaration (rest ...) + (previous ...) + dev titl)) + ((_ (field rest ...) (previous ...) dev titl) + (process-file-system-declaration (rest ...) + (previous ... field) + dev titl)))) + +(define-syntax-rule (file-system fields ...) + (process-file-system-declaration (fields ...) () #f #f)) + +(define (file-system-title fs) ;deprecated + (match (file-system-device fs) + ((? file-system-label?) 'label) + ((? uuid?) 'uuid) + ((? string?) 'device))) + ;; Note: This module is used both on the build side and on the host side. ;; Arrange not to pull (guix store) and (guix config) because the latter ;; differs from user to user. @@ -160,23 +241,26 @@ store--e.g., if FS is the root file system." "Return a list corresponding to file-system FS that can be passed to the initrd code." (match fs - (($ device title mount-point type flags options _ _ check?) - (list (if (uuid? device) - `(uuid ,(uuid-type device) ,(uuid-bytevector device)) - device) - title mount-point type flags options check?)))) + (($ device mount-point type flags options _ _ check?) + (list (cond ((uuid? device) + `(uuid ,(uuid-type device) ,(uuid-bytevector device))) + ((file-system-label? device) + `(file-system-label ,(file-system-label->string device))) + (else device)) + mount-point type flags options check?)))) (define (spec->file-system sexp) "Deserialize SEXP, a list, to the corresponding object." (match sexp - ((device title mount-point type flags options check?) + ((device mount-point type flags options check?) (file-system (device (match device (('uuid (? symbol? type) (? bytevector? bv)) (bytevector->uuid bv type)) + (('file-system-label (? string? label)) + (file-system-label label)) (_ device))) - (title title) (mount-point mount-point) (type type) (flags flags) (options options) (check? check?))))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index eb73b5ca7a..7f80147150 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -693,13 +693,12 @@ environment with the store shared with the host. MAPPINGS is a list of (source (file-system-device fs))) (or (string=? target (%store-prefix)) (string=? target "/") - (and (eq? 'device (file-system-title fs)) + (and (string? source) (string-prefix? "/dev/" source)) ;; Labels and UUIDs are necessarily invalid in the VM. (and (file-system-mount? fs) - (or (eq? 'label (file-system-title fs)) - (eq? 'uuid (file-system-title fs)) + (or (file-system-label? source) (uuid? source)))))) (operating-system-file-systems os))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index af501eb8f7..5d0df14924 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -590,17 +590,17 @@ any, are available. Raise an error if they're not." (define labeled (filter (lambda (fs) - (eq? (file-system-title fs) 'label)) + (file-system-label? (file-system-device fs))) relevant)) (define literal (filter (lambda (fs) - (eq? (file-system-title fs) 'device)) + (string? (file-system-device fs))) relevant)) (define uuid (filter (lambda (fs) - (eq? (file-system-title fs) 'uuid)) + (uuid? (file-system-device fs))) relevant)) (define fail? #f) @@ -628,15 +628,15 @@ any, are available. Raise an error if they're not." (strerror errno)) (unless (string-prefix? "/" device) (display-hint (format #f (G_ "If '~a' is a file system -label, you need to add @code{(title 'label)} to your @code{file-system} -definition.") - device))))))) +label, write @code{(file-system-label ~s)} in your @code{device} field.") + device device))))))) literal) (for-each (lambda (fs) - (unless (find-partition-by-label (file-system-device fs)) - (error (G_ "~a: error: file system with label '~a' not found~%") - (file-system-location* fs) - (file-system-device fs)))) + (let ((label (file-system-label->string + (file-system-device fs)))) + (unless (find-partition-by-label label) + (error (G_ "~a: error: file system with label '~a' not found~%") + (file-system-location* fs) label)))) labeled) (for-each (lambda (fs) (unless (find-partition-by-uuid (file-system-device fs)) @@ -677,10 +677,13 @@ available in the initrd. Note that mapped devices are responsible for checking this by themselves in their 'check' procedure." (define (file-system-/dev fs) (let ((device (file-system-device fs))) - (match (file-system-title fs) - ('device device) - ('uuid (find-partition-by-uuid device)) - ('label (find-partition-by-label device))))) + (match device + ((? string?) + device) + ((? uuid?) + (find-partition-by-uuid device)) + ((? file-system-label?) + (find-partition-by-label (file-system-label->string device)))))) (define file-systems (filter file-system-needed-for-boot? -- cgit v1.2.3 From 0d56d9c714dc986fd049e07d8ad423d1e944771f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 29 May 2018 15:06:42 +0200 Subject: services: fstab: Properly handle file system labels. Fixes a regression introduced in a5acc17a3c10a3779b5b8b1a2565ef130be77e51. Reported by Tobias Geerinckx-Rice . * gnu/services/base.scm (file-system->fstab-entry): Pass LABEL, not FILE-SYSTEM, to 'file-system-label->string'. --- gnu/services/base.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 09a1ce95e3..b34bb7132b 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -306,7 +306,7 @@ seconds after @code{SIGTERM} has been sent are terminated with (string-append (match (file-system-device file-system) ((? file-system-label? label) (string-append "LABEL=" - (file-system-label->string file-system))) + (file-system-label->string label))) ((? uuid? uuid) (string-append "UUID=" (uuid->string uuid))) ((? string? device) -- cgit v1.2.3 From 93b83eb31e35aedaafcc40cfbb9a8743e0f6352d Mon Sep 17 00:00:00 2001 From: Rouby Pierre-Antoine Date: Wed, 30 May 2018 11:47:04 +0200 Subject: services: Add hpcguix-web. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/service/web.scm (): New record-type. (%hpcguix-web-accounts): New variable. (%hpcguix-web-activation,hpcguix-web-shepherd-service, hpcguix-web-service-type): New procedures. * gnu/tests/web.scm (run-hpcguix-web-server-test): New procedure. (%hpcguix-web-specs, %hpcguix-web-os, %test-hpcguix-web): New variable. * doc/guix.texi (Web Services): Add 'hpcguix-web'. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 61 +++++++++++++++++++++++++++++++++++++- gnu/services/web.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++- gnu/tests/web.scm | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 212 insertions(+), 3 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 09749b15e1..3b5078741d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -47,7 +47,8 @@ Copyright @copyright{} 2017, 2018 Arun Isaac@* Copyright @copyright{} 2017 nee@* Copyright @copyright{} 2018 Rutger Helling@* Copyright @copyright{} 2018 Oleg Pykhalov@* -Copyright @copyright{} 2018 Mike Gerwitz +Copyright @copyright{} 2018 Mike Gerwitz@* +Copyright @copyright{} 2018 Pierre-Antoine Rouby Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -16159,6 +16160,64 @@ A simple setup for cat-avatar-generator can look like this: %base-services)) @end example +@subsubheading Hpcguix-web + +@cindex hpcguix-web +The @uref{hpcguix-web, https://github.com/UMCUGenetics/hpcguix-web/} +program is a customizable web interface to browse Guix packages, +initially designed for users of high-performance computing (HPC) +clusters. + +@defvr {Scheme Variable} hpcguix-web-service-type +The service type for @code{hpcguix-web}. +@end defvr + +@deftp {Data Type} hpcguix-web-configuration +Data type for the hpcguix-web service configuration. + +@table @asis +@item @code{specs} +A gexp (@pxref{G-Expressions}) specifying the hpcguix-web service +configuration. The main items available in this spec are: + +@table @asis +@item @code{title-prefix} (default: @code{"hpcguix | "}) +The page title prefix. + +@item @code{guix-command} (default: @code{"guix"}) +The @command{guix} command. + +@item @code{package-filter-proc} (default: @code{(const #t)}) +A procedure specifying how to filter packages that are displayed. + +@item @code{package-page-extension-proc} (default: @code{(const '())}) +Extension package for @code{hpcguix-web}. + +@item @code{menu} (default: @code{'()}) +Additional entry in page @code{menu}. +@end table + +See the hpcguix-web repository for a +@uref{https://github.com/UMCUGenetics/hpcguix-web/blob/master/hpcweb-configuration.scm, +complete example}. + +@item @code{package} (default: @code{hpcguix-web}) +The hpcguix-web package to use. +@end table +@end deftp + +A typical hpcguix-web service declaration looks like this: + +@example +(service hpcguix-web-service-type + (hpcguix-web-configuration + (specs + #~(define site-config + (hpcweb-configuration + (title-prefix "Guix-HPC - ") + (menu '(("/about" "ABOUT")))))))) +@end example + @node Certificate Services @subsubsection Certificate Services diff --git a/gnu/services/web.scm b/gnu/services/web.scm index b336a8dd30..aae2f3db0d 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2017 Christopher Baines ;;; Copyright © 2017 nee ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2018 Pierre-Antoine Rouby ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,11 +26,14 @@ (define-module (gnu services web) #:use-module (gnu services) #:use-module (gnu services shepherd) + #:use-module (gnu system pam) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages web) #:use-module (gnu packages php) + #:use-module (gnu packages guile) #:use-module (guix records) + #:use-module (guix modules) #:use-module (guix gexp) #:use-module ((guix utils) #:select (version-major)) #:use-module ((guix packages) #:select (package-version)) @@ -155,7 +159,11 @@ php-fpm-service-type nginx-php-location - cat-avatar-generator-service)) + cat-avatar-generator-service + + hpcguix-web-configuration + hpcguix-web-configuration? + hpcguix-web-service-type)) ;;; Commentary: ;;; @@ -893,3 +901,65 @@ a webserver.") (nginx-server-configuration-locations configuration))) (root #~(string-append #$package "/share/web/cat-avatar-generator")))))) + + +(define-record-type* + hpcguix-web-configuration make-hpcguix-web-configuration + hpcguix-web-configuration? + + (package hpcguix-web-package (default hpcguix-web)) ; + + ;; Specs is gexp of hpcguix-web configuration file + (specs hpcguix-web-configuration-specs)) + +(define %hpcguix-web-accounts + (list (user-group + (name "hpcguix-web") + (system? #t)) + (user-account + (name "hpcguix-web") + (group "hpcguix-web") + (system? #t) + (comment "hpcguix-web") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define %hpcguix-web-activation + #~(begin + (use-modules (guix build utils)) + (let ((home-dir "/var/cache/guix/web") + (user (getpwnam "hpcguix-web"))) + (mkdir-p home-dir) + (chown home-dir (passwd:uid user) (passwd:gid user)) + (chmod home-dir #o755)))) + +(define (hpcguix-web-shepherd-service config) + (let ((specs (hpcguix-web-configuration-specs config)) + (hpcguix-web (hpcguix-web-package config))) + (with-imported-modules (source-module-closure + '((gnu build shepherd))) + (shepherd-service + (documentation "hpcguix-web daemon") + (provision '(hpcguix-web)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list #$(file-append hpcguix-web "/bin/run") + (string-append "--config=" + #$(scheme-file "hpcguix-web.scm" specs))) + #:user "hpcguix-web" + #:group "hpcguix-web" + #:environment-variables + (list "XDG_CACHE_HOME=/var/cache"))) + (stop #~(make-kill-destructor)))))) + +(define hpcguix-web-service-type + (service-type + (name 'hpcguix-web) + (description "Run the hpcguix-web server.") + (extensions + (list (service-extension account-service-type + (const %hpcguix-web-accounts)) + (service-extension activation-service-type + (const %hpcguix-web-activation)) + (service-extension shepherd-root-service-type + (compose list hpcguix-web-shepherd-service)))))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 1912f8f79d..a6bf6efcfe 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Ludovic Courtès ;;; Copyright © 2017 Christopher Baines ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2018 Pierre-Antoine Rouby ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,7 +32,8 @@ #:use-module (guix store) #:export (%test-httpd %test-nginx - %test-php-fpm)) + %test-php-fpm + %test-hpcguix-web)) (define %index.html-contents ;; Contents of the /index.html file. @@ -281,3 +283,81 @@ HTTP-PORT, along with php-fpm." (name "php-fpm") (description "Test PHP-FPM through nginx.") (value (run-php-fpm-test)))) + + +;;; +;;; hpcguix-web +;;; + +(define* (run-hpcguix-web-server-test name test-os) + "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running." + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings '((8080 . 5000))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin #$name) + + (test-assert "hpcguix-web running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'hpcguix-web) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((pid) (number? pid)))))) + marionette)) + + (test-equal "http-get" + 200 + (begin + (wait-for-tcp-port 5000 marionette) + (let-values (((response text) + (http-get "http://localhost:8080"))) + (response-code response)))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation (string-append name "-test") test)) + +(define %hpcguix-web-specs + ;; Server config gexp. + #~(define site-config + (hpcweb-configuration + (title-prefix "[TEST] HPCGUIX-WEB")))) + +(define %hpcguix-web-os + (simple-operating-system + (dhcp-client-service) + (service hpcguix-web-service-type + (hpcguix-web-configuration + (specs %hpcguix-web-specs))))) + +(define %test-hpcguix-web + (system-test + (name "hpcguix-web") + (description "Connect to a running hpcguix-web server.") + (value (run-hpcguix-web-server-test name %hpcguix-web-os)))) -- cgit v1.2.3 From 97f6e9133a03f37c79e60678dd5670a805cdf693 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Sat, 2 Jun 2018 23:23:45 +0800 Subject: services: Add dnsmasq-service-type. * gnu/services/dns.scm (dnsmasq-service-type): New variable. (): New record type. (dnsmasq-shepherd-service): New procedure. * doc/guix.texi (DNS Services): Document it. --- doc/guix.texi | 59 ++++++++++++++++++++++++++++++++++++++- gnu/services/dns.scm | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 136 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 77bdaa50eb..e1353842e4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16405,7 +16405,11 @@ saved to @code{/etc/letsencrypt/live/@var{name}/privkey.pem}. The @code{(gnu services dns)} module provides services related to the @dfn{domain name system} (DNS). It provides a server service for hosting an @emph{authoritative} DNS server for multiple zones, slave or master. -This service uses @uref{https://www.knot-dns.cz/, Knot DNS}. +This service uses @uref{https://www.knot-dns.cz/, Knot DNS}. And also a +caching and forwarding DNS server for the LAN, which uses +@uref{http://www.thekelleys.org.uk/dnsmasq/doc.html, dnsmasq}. + +@subsubheading Knot Service An example configuration of an authoritative server for two zones, one master and one slave, is: @@ -16800,6 +16804,59 @@ The list of knot-zone-configuration used by this configuration. @end table @end deftp +@subsubheading Dnsmasq Service + +@deffn {Scheme Variable} dnsmasq-service-type +This is the type of the dnsmasq service, whose value should be an +@code{dnsmasq-configuration} object as in this example: + +@example +(service dnsmasq-service-type + (dnsmasq-configuration + (no-resolv? #t) + (servers '("192.168.1.1")))) +@end example +@end deffn + +@deftp {Data Type} dnsmasq-configuration +Data type representing the configuration of dnsmasq. + +@table @asis +@item @code{package} (default: @var{dnsmasq}) +Package object of the dnsmasq server. + +@item @code{no-hosts?} (default: @code{#f}) +When true, don't read the hostnames in /etc/hosts. + +@item @code{port} (default: @code{53}) +The port to listen on. Setting this to zero completely disables DNS +funtion, leaving only DHCP and/or TFTP. + +@item @code{local-service?} (default: @code{#t}) +Accept DNS queries only from hosts whose address is on a local subnet, +ie a subnet for which an interface exists on the server. + +@item @code{listen-addresses} (default: @code{'()}) +Listen on the given IP addresses. + +@item @code{resolv-file} (default: @code{"/etc/resolv.conf"}) +The file to read the IP address of the upstream nameservers from. + +@item @code{no-resolv?} (default: @code{#f}) +When true, don't read @var{resolv-file}. + +@item @code{servers} (default: @code{'()}) +Specify IP address of upstream servers directly. + +@item @code{cache-size} (default: @code{150}) +Set the size of dnsmasq's cache. Setting the cache size to zero +disables caching. + +@item @code{no-negcache?} (default: @code{#f}) +When true, disable negative caching. + +@end table +@end deftp @node VPN Services @subsubsection VPN Services diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index 673ab1a98d..d0913e90ed 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -27,6 +27,7 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) @@ -41,7 +42,10 @@ knot-configuration define-zone-entries zone-file - zone-entry)) + zone-entry + + dnsmasq-service-type + dnsmasq-configuration)) ;;; ;;; Knot DNS. @@ -591,3 +595,76 @@ knot-activation) (service-extension account-service-type (const %knot-accounts)))))) + + +;;; +;;; Dnsmasq. +;;; + +(define-record-type* + dnsmasq-configuration make-dnsmasq-configuration + dnsmasq-configuration? + (package dnsmasq-configuration-package + (default dnsmasq)) ;package + (no-hosts? dnsmasq-configuration-no-hosts? + (default #f)) ;boolean + (port dnsmasq-configuration-port + (default 53)) ;integer + (local-service? dnsmasq-configuration-local-service? + (default #t)) ;boolean + (listen-addresses dnsmasq-configuration-listen-address + (default '())) ;list of string + (resolv-file dnsmasq-configuration-resolv-file + (default "/etc/resolv.conf")) ;string + (no-resolv? dnsmasq-configuration-no-resolv? + (default #f)) ;boolean + (servers dnsmasq-configuration-servers + (default '())) ;list of string + (cache-size dnsmasq-configuration-cache-size + (default 150)) ;integer + (no-negcache? dnsmasq-configuration-no-negcache? + (default #f))) ;boolean + +(define dnsmasq-shepherd-service + (match-lambda + (($ package + no-hosts? + port local-service? listen-addresses + resolv-file no-resolv? servers + cache-size no-negcache?) + (shepherd-service + (provision '(dnsmasq)) + (requirement '(networking)) + (documentation "Run the dnsmasq DNS server.") + (start #~(make-forkexec-constructor + '(#$(file-append package "/sbin/dnsmasq") + "--keep-in-foreground" + "--pid-file=/run/dnsmasq.pid" + #$@(if no-hosts? + '("--no-hosts") + '()) + #$(format #f "--port=~a" port) + #$@(if local-service? + '("--local-service") + '()) + #$@(map (cut format #f "--listen-address=~a" <>) + listen-addresses) + #$(format #f "--resolv-file=~a" resolv-file) + #$@(if no-resolv? + '("--no-resolv") + '()) + #$@(map (cut format #f "--server=~a" <>) + servers) + #$(format #f "--cache-size=~a" cache-size) + #$@(if no-negcache? + '("--no-negcache") + '())) + #:pid-file "/run/dnsmasq.pid")) + (stop #~(make-kill-destructor)))))) + +(define dnsmasq-service-type + (service-type + (name 'dnsmasq) + (extensions + (list (service-extension shepherd-root-service-type + (compose list dnsmasq-shepherd-service)))))) -- cgit v1.2.3 From c061eb587cbb8590a5cd4793b56a01560af747a8 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 8 Jun 2018 23:12:37 +0800 Subject: services: dnsmasq: Use 'negative-cache?' instead of 'no-negcache?'. The 'no-negcache?' option is mapped to the '--no-negcache' command-line argument directly, but we're in the scheme world, where the general guideline is to avoid double-negations in identifiers. * gnu/services/dns.scm : Replace the 'no-negcache?' field with 'negative-cache?'. * doc/guix.texi (DNS Services)[Dnsmasq Service]: Adjust accordingly. --- doc/guix.texi | 4 ++-- gnu/services/dns.scm | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 1183565ad3..965ac420ff 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16858,8 +16858,8 @@ Specify IP address of upstream servers directly. Set the size of dnsmasq's cache. Setting the cache size to zero disables caching. -@item @code{no-negcache?} (default: @code{#f}) -When true, disable negative caching. +@item @code{negative-cache?} (default: @code{#t}) +When false, disable negative caching. @end table @end deftp diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index d0913e90ed..1b39d0f508 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -622,8 +622,8 @@ (default '())) ;list of string (cache-size dnsmasq-configuration-cache-size (default 150)) ;integer - (no-negcache? dnsmasq-configuration-no-negcache? - (default #f))) ;boolean + (negative-cache? dnsmasq-configuration-negative-cache? + (default #t))) ;boolean (define dnsmasq-shepherd-service (match-lambda @@ -631,7 +631,7 @@ no-hosts? port local-service? listen-addresses resolv-file no-resolv? servers - cache-size no-negcache?) + cache-size negative-cache?) (shepherd-service (provision '(dnsmasq)) (requirement '(networking)) @@ -656,9 +656,9 @@ #$@(map (cut format #f "--server=~a" <>) servers) #$(format #f "--cache-size=~a" cache-size) - #$@(if no-negcache? - '("--no-negcache") - '())) + #$@(if negative-cache? + '() + '("--no-negcache"))) #:pid-file "/run/dnsmasq.pid")) (stop #~(make-kill-destructor)))))) -- cgit v1.2.3 From 0d4c2d35aff1bb28e2c105b9d7efc8c2a12d4601 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 8 Jun 2018 23:31:31 +0800 Subject: services: dnsmasq-service-type: Add default configuration and description. * gnu/services/dns.scm (dnsmasq-service-type) [default-value, description]: New fields. --- gnu/services/dns.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index 1b39d0f508..2c57a36b84 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -667,4 +667,6 @@ (name 'dnsmasq) (extensions (list (service-extension shepherd-root-service-type - (compose list dnsmasq-shepherd-service)))))) + (compose list dnsmasq-shepherd-service)))) + (default-value (dnsmasq-configuration)) + (description "Run the dnsmasq DNS server."))) -- cgit v1.2.3