From 5eca94594d5f0d834d4ca918b894400e3a7f6aa1 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sat, 25 Apr 2015 22:52:29 +0300 Subject: services: Add console-keymap service. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/base.scm (console-keymap-service): New procedure. * doc/guix.texi (Base Services): Document it. Co-authored-by: 宋文武 --- gnu/services/base.scm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d0a2e8c848..697b9395c2 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2015 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -46,6 +47,7 @@ (define-module (gnu services base) swap-service user-processes-service host-name-service + console-keymap-service console-font-service udev-service mingetty-service @@ -313,6 +315,19 @@ (define (unicode-start tty) (else (zero? (cdr (waitpid pid)))))))) +(define (console-keymap-service file) + "Return a service to load console keymap from @var{file}." + (with-monad %store-monad + (return + (service + (documentation + (string-append "Load console keymap (loadkeys).")) + (provision '(console-keymap)) + (start #~(lambda _ + (zero? (system* (string-append #$kbd "/bin/loadkeys") + #$file)))) + (respawn? #f))))) + (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16")) "Return a service that sets up Unicode support in @var{tty} and loads @var{font} for that tty (fonts are per virtual console in Linux.)" -- cgit v1.2.3 From fe1a39d319258c26fb9bcedc2fd337a9e2f40df9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 May 2015 19:36:10 +0200 Subject: services: Group desktop services in (gnu services desktop). * gnu/services/colord.scm, gnu/services/dbus.scm, gnu/services/upower.scm: Remove. * gnu/services/desktop.scm: New file, with contents taken from the above files. * gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly. * doc/guix.texi (Desktop Services): New section. (Various Services): Move colord-service and upower-service from here to "Desktop Services". --- doc/guix.texi | 56 +++++++--- gnu-system.am | 4 +- gnu/services/colord.scm | 72 ------------- gnu/services/dbus.scm | 127 ---------------------- gnu/services/desktop.scm | 270 +++++++++++++++++++++++++++++++++++++++++++++++ gnu/services/upower.scm | 122 --------------------- 6 files changed, 310 insertions(+), 341 deletions(-) delete mode 100644 gnu/services/colord.scm delete mode 100644 gnu/services/dbus.scm create mode 100644 gnu/services/desktop.scm delete mode 100644 gnu/services/upower.scm (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index d9db408e57..8241cb07bf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4641,6 +4641,7 @@ declaration. * Base Services:: Essential system services. * Networking Services:: Network setup, SSH daemon, etc. * X Window:: Graphical display. +* Desktop Services:: D-Bus and desktop services. * Various Services:: Other services. @end menu @@ -4985,27 +4986,29 @@ appropriate screen resolution; otherwise, it must be a list of resolutions---e.g., @code{((1024 768) (640 480))}. @end deffn -@node Various Services -@subsubsection Various Services +@node Desktop Services +@subsubsection Desktop Services -The @code{(gnu services lirc)} module provides the following service. +The @code{(gnu services desktop)} module provides services that are +usually useful in the context of a ``desktop'' setup---that is, on a +machine running a graphical display server, possibly with graphical user +interfaces, etc. -@deffn {Monadic Procedure} lirc-service [#:lirc lirc] @ - [#:device #f] [#:driver #f] [#:config-file #f] @ - [#:extra-options '()] -Return a service that runs @url{http://www.lirc.org,LIRC}, a daemon that -decodes infrared signals from remote controls. +@deffn {Monadic Procedure} dbus-service @var{services} @ + [#:dbus @var{dbus}] +Return a service that runs the ``system bus'', using @var{dbus}, with +support for @var{services}. -Optionally, @var{device}, @var{driver} and @var{config-file} -(configuration file name) may be specified. See @command{lircd} manual -for details. +@uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication +facility. Its system bus is used to allow system services to communicate +and be notified of system-wide events. -Finally, @var{extra-options} is a list of additional command-line options -passed to @command{lircd}. +@var{services} must be a list of packages that provide an +@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration +and policy files. For example, to allow avahi-daemon to use the system bus, +@var{services} must be equal to @code{(list avahi)}. @end deffn -@code{(gnu services upower)} provides a power-management daemon: - @deffn {Monadic Procedure} upower-service [#:upower @var{upower}] @ [#:watts-up-pro? #f] @ [#:poll-batteries? #t] @ @@ -5025,8 +5028,6 @@ levels, with the given configuration settings. It implements the GNOME. @end deffn -@code{(gnu services colord)} provides a color management service: - @deffn {Monadic Procedure} colord-service [#:colord @var{colord}] Return a service that runs @command{colord}, a system service with a D-Bus interface to manage the color profiles of input and output devices such as @@ -5035,6 +5036,27 @@ tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web site} for more information. @end deffn + +@node Various Services +@subsubsection Various Services + +The @code{(gnu services lirc)} module provides the following service. + +@deffn {Monadic Procedure} lirc-service [#:lirc lirc] @ + [#:device #f] [#:driver #f] [#:config-file #f] @ + [#:extra-options '()] +Return a service that runs @url{http://www.lirc.org,LIRC}, a daemon that +decodes infrared signals from remote controls. + +Optionally, @var{device}, @var{driver} and @var{config-file} +(configuration file name) may be specified. See @command{lircd} manual +for details. + +Finally, @var{extra-options} is a list of additional command-line options +passed to @command{lircd}. +@end deffn + + @node Setuid Programs @subsection Setuid Programs diff --git a/gnu-system.am b/gnu-system.am index 798188f7e7..9ffb76ee5d 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -329,13 +329,11 @@ GNU_SYSTEM_MODULES = \ gnu/services.scm \ gnu/services/avahi.scm \ gnu/services/base.scm \ - gnu/services/colord.scm \ - gnu/services/dbus.scm \ + gnu/services/desktop.scm \ gnu/services/dmd.scm \ gnu/services/lirc.scm \ gnu/services/networking.scm \ gnu/services/ssh.scm \ - gnu/services/upower.scm \ gnu/services/xorg.scm \ \ gnu/system.scm \ diff --git a/gnu/services/colord.scm b/gnu/services/colord.scm deleted file mode 100644 index 588436002c..0000000000 --- a/gnu/services/colord.scm +++ /dev/null @@ -1,72 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès -;;; Copyright © 2015 Andy Wingo -;;; -;;; 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 colord) - #:use-module (gnu services) - #:use-module (gnu system shadow) - #:use-module (gnu packages gnome) - #:use-module (ice-9 match) - #:use-module (guix monads) - #:use-module (guix store) - #:use-module (guix gexp) - #:export (colord-service)) - -;;; Commentary: -;;; -;;; This module provides service definitions for the colord color management -;;; service. -;;; -;;; Code: - -(define* (colord-service #:key (colord colord)) - "Return a service that runs @command{colord}, a system service with a D-Bus -interface to manage the color profiles of input and output devices such as -screens and scanners. It is notably used by the GNOME Color Manager graphical -tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web -site} for more information." - (with-monad %store-monad - (return - (service - (documentation "Run the colord color management service.") - (provision '(colord-daemon)) - (requirement '(dbus-system udev)) - - (start #~(make-forkexec-constructor - (list (string-append #$colord "/libexec/colord")))) - (stop #~(make-kill-destructor)) - (activate #~(begin - (use-modules (guix build utils)) - (mkdir-p "/var/lib/colord") - (let ((user (getpwnam "colord"))) - (chown "/var/lib/colord" - (passwd:uid user) (passwd:gid user))))) - - (user-groups (list (user-group - (name "colord") - (system? #t)))) - (user-accounts (list (user-account - (name "colord") - (group "colord") - (system? #t) - (comment "colord daemon user") - (home-directory "/var/empty") - (shell - "/run/current-system/profile/sbin/nologin")))))))) - -;;; colord.scm ends here diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm deleted file mode 100644 index 8f3b350951..0000000000 --- a/gnu/services/dbus.scm +++ /dev/null @@ -1,127 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès -;;; -;;; 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 dbus) - #:use-module (gnu services) - #:use-module (gnu system shadow) - #:use-module (gnu packages glib) - #:use-module (gnu packages admin) - #:use-module (guix monads) - #:use-module (guix store) - #:use-module (guix gexp) - #:export (dbus-service)) - -;;; Commentary: -;;; -;;; This module supports the configuration of the D-Bus message bus -;;; (http://dbus.freedesktop.org/). D-Bus is an inter-process communication -;;; facility. Its "system bus" is used to allow system services to -;;; communicate and be notified of system-wide events. -;;; -;;; Code: - -(define (dbus-configuration-directory dbus services) - "Return a configuration directory for @var{dbus} that includes the -@code{etc/dbus-1/system.d} directories of each package listed in -@var{services}." - (define build - #~(begin - (use-modules (sxml simple) - (srfi srfi-1)) - - (define (services->sxml services) - ;; Return the SXML 'includedir' clauses for DIRS. - `(busconfig - ,@(append-map (lambda (dir) - `((includedir - ,(string-append dir "/etc/dbus-1/system.d")) - (servicedir ;for '.service' files - ,(string-append dir "/share/dbus-1/services")))) - services))) - - (mkdir #$output) - (copy-file (string-append #$dbus "/etc/dbus-1/system.conf") - (string-append #$output "/system.conf")) - - ;; The default 'system.conf' has an clause for - ;; 'system.d', so create it. - (mkdir (string-append #$output "/system.d")) - - ;; 'system-local.conf' is automatically included by the default - ;; 'system.conf', so this is where we stuff our own things. - (call-with-output-file (string-append #$output "/system-local.conf") - (lambda (port) - (sxml->xml (services->sxml (list #$@services)) - port))))) - - (gexp->derivation "dbus-configuration" build)) - -(define* (dbus-service services #:key (dbus dbus)) - "Return a service that runs the system bus, using @var{dbus}, with support -for @var{services}. - -@var{services} must be a list of packages that provide an -@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration -and policy files. For example, to allow avahi-daemon to use the system bus, -@var{services} must be equal to @code{(list avahi)}." - (mlet %store-monad ((conf (dbus-configuration-directory dbus services))) - (return - (service - (documentation "Run the D-Bus system daemon.") - (provision '(dbus-system)) - (requirement '(user-processes)) - (start #~(make-forkexec-constructor - (list (string-append #$dbus "/bin/dbus-daemon") - "--nofork" - (string-append "--config-file=" #$conf "/system.conf")))) - (stop #~(make-kill-destructor)) - (user-groups (list (user-group - (name "messagebus") - (system? #t)))) - (user-accounts (list (user-account - (name "messagebus") - (group "messagebus") - (system? #t) - (comment "D-Bus system bus user") - (home-directory "/var/run/dbus") - (shell - #~(string-append #$shadow "/sbin/nologin"))))) - (activate #~(begin - (use-modules (guix build utils)) - - (mkdir-p "/var/run/dbus") - - (let ((user (getpwnam "messagebus"))) - (chown "/var/run/dbus" - (passwd:uid user) (passwd:gid user))) - - (unless (file-exists? "/etc/machine-id") - (format #t "creating /etc/machine-id...~%") - (let ((prog (string-append #$dbus "/bin/dbus-uuidgen"))) - ;; XXX: We can't use 'system' because the initrd's - ;; guile system(3) only works when 'sh' is in $PATH. - (let ((pid (primitive-fork))) - (if (zero? pid) - (call-with-output-file "/etc/machine-id" - (lambda (port) - (close-fdes 1) - (dup2 (port->fdes port) 1) - (execl prog))) - (waitpid pid))))))))))) - -;;; dbus.scm ends here diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm new file mode 100644 index 0000000000..5945f7af18 --- /dev/null +++ b/gnu/services/desktop.scm @@ -0,0 +1,270 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015 Ludovic Courtès +;;; Copyright © 2015 Andy Wingo +;;; +;;; 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 desktop) + #:use-module (gnu services) + #:use-module (gnu system shadow) + #:use-module (gnu packages glib) + #:use-module (gnu packages admin) + #:use-module (gnu packages gnome) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix gexp) + #:use-module (ice-9 match) + #:export (dbus-service + upower-service + colord-service)) + +;;; Commentary: +;;; +;;; This module contains service definitions for a "desktop" environment. +;;; +;;; Code: + + +;;; +;;; D-Bus. +;;; + +(define (dbus-configuration-directory dbus services) + "Return a configuration directory for @var{dbus} that includes the +@code{etc/dbus-1/system.d} directories of each package listed in +@var{services}." + (define build + #~(begin + (use-modules (sxml simple) + (srfi srfi-1)) + + (define (services->sxml services) + ;; Return the SXML 'includedir' clauses for DIRS. + `(busconfig + ,@(append-map (lambda (dir) + `((includedir + ,(string-append dir "/etc/dbus-1/system.d")) + (servicedir ;for '.service' files + ,(string-append dir "/share/dbus-1/services")))) + services))) + + (mkdir #$output) + (copy-file (string-append #$dbus "/etc/dbus-1/system.conf") + (string-append #$output "/system.conf")) + + ;; The default 'system.conf' has an clause for + ;; 'system.d', so create it. + (mkdir (string-append #$output "/system.d")) + + ;; 'system-local.conf' is automatically included by the default + ;; 'system.conf', so this is where we stuff our own things. + (call-with-output-file (string-append #$output "/system-local.conf") + (lambda (port) + (sxml->xml (services->sxml (list #$@services)) + port))))) + + (gexp->derivation "dbus-configuration" build)) + +(define* (dbus-service services #:key (dbus dbus)) + "Return a service that runs the \"system bus\", using @var{dbus}, with +support for @var{services}. + +@uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication +facility. Its system bus is used to allow system services to communicate and +be notified of system-wide events. + +@var{services} must be a list of packages that provide an +@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration +and policy files. For example, to allow avahi-daemon to use the system bus, +@var{services} must be equal to @code{(list avahi)}." + (mlet %store-monad ((conf (dbus-configuration-directory dbus services))) + (return + (service + (documentation "Run the D-Bus system daemon.") + (provision '(dbus-system)) + (requirement '(user-processes)) + (start #~(make-forkexec-constructor + (list (string-append #$dbus "/bin/dbus-daemon") + "--nofork" + (string-append "--config-file=" #$conf "/system.conf")))) + (stop #~(make-kill-destructor)) + (user-groups (list (user-group + (name "messagebus") + (system? #t)))) + (user-accounts (list (user-account + (name "messagebus") + (group "messagebus") + (system? #t) + (comment "D-Bus system bus user") + (home-directory "/var/run/dbus") + (shell + #~(string-append #$shadow "/sbin/nologin"))))) + (activate #~(begin + (use-modules (guix build utils)) + + (mkdir-p "/var/run/dbus") + + (let ((user (getpwnam "messagebus"))) + (chown "/var/run/dbus" + (passwd:uid user) (passwd:gid user))) + + (unless (file-exists? "/etc/machine-id") + (format #t "creating /etc/machine-id...~%") + (let ((prog (string-append #$dbus "/bin/dbus-uuidgen"))) + ;; XXX: We can't use 'system' because the initrd's + ;; guile system(3) only works when 'sh' is in $PATH. + (let ((pid (primitive-fork))) + (if (zero? pid) + (call-with-output-file "/etc/machine-id" + (lambda (port) + (close-fdes 1) + (dup2 (port->fdes port) 1) + (execl prog))) + (waitpid pid))))))))))) + + +;;; +;;; Upower D-Bus service. +;;; + +(define* (upower-configuration-file #:key watts-up-pro? poll-batteries? + ignore-lid? use-percentage-for-policy? + percentage-low percentage-critical + percentage-action time-low + time-critical time-action + critical-power-action) + "Return an upower-daemon configuration file." + (define (bool value) + (if value "true\n" "false\n")) + + (text-file "UPower.conf" + (string-append + "[UPower]\n" + "EnableWattsUpPro=" (bool watts-up-pro?) + "NoPollBatteries=" (bool (not poll-batteries?)) + "IgnoreLid=" (bool ignore-lid?) + "UsePercentageForPolicy=" (bool use-percentage-for-policy?) + "PercentageLow=" (number->string percentage-low) "\n" + "PercentageCritical=" (number->string percentage-critical) "\n" + "PercentageAction=" (number->string percentage-action) "\n" + "TimeLow=" (number->string time-low) "\n" + "TimeCritical=" (number->string time-critical) "\n" + "TimeAction=" (number->string time-action) "\n" + "CriticalPowerAction=" (match critical-power-action + ('hybrid-sleep "HybridSleep") + ('hibernate "Hibernate") + ('power-off "PowerOff")) + "\n"))) + +(define* (upower-service #:key (upower upower) + (watts-up-pro? #f) + (poll-batteries? #t) + (ignore-lid? #f) + (use-percentage-for-policy? #f) + (percentage-low 10) + (percentage-critical 3) + (percentage-action 2) + (time-low 1200) + (time-critical 300) + (time-action 120) + (critical-power-action 'hybrid-sleep)) + "Return a service that runs @uref{http://upower.freedesktop.org/, +@command{upowerd}}, a system-wide monitor for power consumption and battery +levels, with the given configuration settings. It implements the +@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." + (mlet %store-monad ((config (upower-configuration-file + #:watts-up-pro? watts-up-pro? + #:poll-batteries? poll-batteries? + #:ignore-lid? ignore-lid? + #:use-percentage-for-policy? use-percentage-for-policy? + #:percentage-low percentage-low + #:percentage-critical percentage-critical + #:percentage-action percentage-action + #:time-low time-low + #:time-critical time-critical + #:time-action time-action + #:critical-power-action critical-power-action))) + (return + (service + (documentation "Run the UPower power and battery monitor.") + (provision '(upower-daemon)) + (requirement '(dbus-system udev)) + + (start #~(make-forkexec-constructor + (list (string-append #$upower "/libexec/upowerd")) + #:environment-variables + (list (string-append "UPOWER_CONF_FILE_NAME=" #$config)))) + (stop #~(make-kill-destructor)) + (activate #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/lib/upower") + (let ((user (getpwnam "upower"))) + (chown "/var/lib/upower" + (passwd:uid user) (passwd:gid user))))) + + (user-groups (list (user-group + (name "upower") + (system? #t)))) + (user-accounts (list (user-account + (name "upower") + (group "upower") + (system? #t) + (comment "UPower daemon user") + (home-directory "/var/empty") + (shell + #~(string-append #$shadow "/sbin/nologin"))))))))) + + +;;; +;;; Colord D-Bus service. +;;; + +(define* (colord-service #:key (colord colord)) + "Return a service that runs @command{colord}, a system service with a D-Bus +interface to manage the color profiles of input and output devices such as +screens and scanners. It is notably used by the GNOME Color Manager graphical +tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web +site} for more information." + (with-monad %store-monad + (return + (service + (documentation "Run the colord color management service.") + (provision '(colord-daemon)) + (requirement '(dbus-system udev)) + + (start #~(make-forkexec-constructor + (list (string-append #$colord "/libexec/colord")))) + (stop #~(make-kill-destructor)) + (activate #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/lib/colord") + (let ((user (getpwnam "colord"))) + (chown "/var/lib/colord" + (passwd:uid user) (passwd:gid user))))) + + (user-groups (list (user-group + (name "colord") + (system? #t)))) + (user-accounts (list (user-account + (name "colord") + (group "colord") + (system? #t) + (comment "colord daemon user") + (home-directory "/var/empty") + (shell + #~(string-append #$shadow "/sbin/nologin"))))))))) + +;;; desktop.scm ends here diff --git a/gnu/services/upower.scm b/gnu/services/upower.scm deleted file mode 100644 index 3654c812f1..0000000000 --- a/gnu/services/upower.scm +++ /dev/null @@ -1,122 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Andy Wingo -;;; -;;; 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 upower) - #:use-module (gnu services) - #:use-module (gnu system shadow) - #:use-module (gnu packages gnome) - #:use-module (ice-9 match) - #:use-module (guix monads) - #:use-module (guix store) - #:use-module (guix gexp) - #:export (upower-service)) - -;;; Commentary: -;;; -;;; This module provides service definitions for the UPower power and battery -;;; monitoring service. -;;; -;;; Code: - -(define* (configuration-file #:key watts-up-pro? poll-batteries? ignore-lid? - use-percentage-for-policy? percentage-low - percentage-critical percentage-action - time-low time-critical time-action - critical-power-action) - "Return an upower-daemon configuration file." - (define (bool value) - (if value "true\n" "false\n")) - - (text-file "UPower.conf" - (string-append - "[UPower]\n" - "EnableWattsUpPro=" (bool watts-up-pro?) - "NoPollBatteries=" (bool (not poll-batteries?)) - "IgnoreLid=" (bool ignore-lid?) - "UsePercentageForPolicy=" (bool use-percentage-for-policy?) - "PercentageLow=" (number->string percentage-low) "\n" - "PercentageCritical=" (number->string percentage-critical) "\n" - "PercentageAction=" (number->string percentage-action) "\n" - "TimeLow=" (number->string time-low) "\n" - "TimeCritical=" (number->string time-critical) "\n" - "TimeAction=" (number->string time-action) "\n" - "CriticalPowerAction=" (match critical-power-action - ('hybrid-sleep "HybridSleep") - ('hibernate "Hibernate") - ('power-off "PowerOff")) - "\n"))) - -(define* (upower-service #:key (upower upower) - (watts-up-pro? #f) - (poll-batteries? #t) - (ignore-lid? #f) - (use-percentage-for-policy? #f) - (percentage-low 10) - (percentage-critical 3) - (percentage-action 2) - (time-low 1200) - (time-critical 300) - (time-action 120) - (critical-power-action 'hybrid-sleep)) - "Return a service that runs @uref{http://upower.freedesktop.org/, -@command{upowerd}}, a system-wide monitor for power consumption and battery -levels, with the given configuration settings. It implements the -@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME." - (mlet %store-monad ((config (configuration-file - #:watts-up-pro? watts-up-pro? - #:poll-batteries? poll-batteries? - #:ignore-lid? ignore-lid? - #:use-percentage-for-policy? use-percentage-for-policy? - #:percentage-low percentage-low - #:percentage-critical percentage-critical - #:percentage-action percentage-action - #:time-low time-low - #:time-critical time-critical - #:time-action time-action - #:critical-power-action critical-power-action))) - (return - (service - (documentation "Run the UPower power and battery monitor.") - (provision '(upower-daemon)) - (requirement '(dbus-system udev)) - - (start #~(make-forkexec-constructor - (list (string-append #$upower "/libexec/upowerd")) - #:environment-variables - (list (string-append "UPOWER_CONF_FILE_NAME=" #$config)))) - (stop #~(make-kill-destructor)) - (activate #~(begin - (use-modules (guix build utils)) - (mkdir-p "/var/lib/upower") - (let ((user (getpwnam "upower"))) - (chown "/var/lib/upower" - (passwd:uid user) (passwd:gid user))))) - - (user-groups (list (user-group - (name "upower") - (system? #t)))) - (user-accounts (list (user-account - (name "upower") - (group "upower") - (system? #t) - (comment "UPower daemon user") - (home-directory "/var/empty") - (shell - "/run/current-system/profile/sbin/nologin")))))))) - -;;; upower.scm ends here -- cgit v1.2.3 From 105369a46b6baf94aec5382cad6c70509e3ce1fc Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 3 May 2015 17:02:59 -0400 Subject: gnu: Add postgresql-service. * gnu/services/databases.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi ("Database Services"): New subsubsection. --- doc/guix.texi | 15 ++++++ gnu-system.am | 1 + gnu/services/databases.scm | 121 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 137 insertions(+) create mode 100644 gnu/services/databases.scm (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 1b1690a8e3..2d02a04f9c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4652,6 +4652,7 @@ declaration. * Networking Services:: Network setup, SSH daemon, etc. * X Window:: Graphical display. * Desktop Services:: D-Bus and desktop services. +* Database Services:: SQL databases. * Various Services:: Other services. @end menu @@ -5046,6 +5047,20 @@ tool. See @uref{http://www.freedesktop.org/software/colord/, the colord web site} for more information. @end deffn +@node Database Services +@subsubsection Database Services + +The @code{(gnu services databases)} module provides the following service. + +@deffn {Monadic Procedure} postgresql-service [#:postgresql postgresql] @ + [#:config-file] [#:data-directory ``/var/lib/postgresql/data''] +Return a service that runs @var{postgresql}, the PostgreSQL database +server. + +The PostgreSQL daemon loads its runtime configuration from +@var{config-file} and stores the database cluster in +@var{data-directory}. +@end deffn @node Various Services @subsubsection Various Services diff --git a/gnu-system.am b/gnu-system.am index 2cbb854b89..852d558ad3 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -329,6 +329,7 @@ GNU_SYSTEM_MODULES = \ gnu/services.scm \ gnu/services/avahi.scm \ gnu/services/base.scm \ + gnu/services/databases.scm \ gnu/services/desktop.scm \ gnu/services/dmd.scm \ gnu/services/lirc.scm \ diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm new file mode 100644 index 0000000000..18f41e74da --- /dev/null +++ b/gnu/services/databases.scm @@ -0,0 +1,121 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson +;;; +;;; 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 databases) + #:use-module (gnu services) + #:use-module (gnu system shadow) + #:use-module (gnu packages admin) + #:use-module (gnu packages databases) + #:use-module (guix records) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix gexp) + #:export (postgresql-service)) + +;;; Commentary: +;;; +;;; Database services. +;;; +;;; Code: + +(define %default-postgres-hba + (text-file "pg_hba.conf" + " +local all all trust +host all all 127.0.0.1/32 trust +host all all ::1/128 trust")) + +(define %default-postgres-ident + (text-file "pg_ident.conf" + "# MAPNAME SYSTEM-USERNAME PG-USERNAME")) + +(define %default-postgres-config + (mlet %store-monad ((hba %default-postgres-hba) + (ident %default-postgres-ident)) + (text-file* "postgresql.conf" + ;; The daemon will not start without these. + "hba_file = '" hba "'\n" + "ident_file = '" ident "'\n"))) + +(define* (postgresql-service #:key (postgresql postgresql) + (config-file %default-postgres-config) + (data-directory "/var/lib/postgresql/data")) + "Return a service that runs @var{postgresql}, the PostgreSQL database server. + +The PostgreSQL daemon loads its runtime configuration from @var{config-file} +and stores the database cluster in @var{data-directory}." + ;; Wrapper script that switches to the 'postgres' user before launching + ;; daemon. + (define start-script + (mlet %store-monad ((config-file config-file)) + (gexp->script "start-postgres" + #~(let ((user (getpwnam "postgres")) + (postgres (string-append #$postgresql + "/bin/postgres"))) + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + (system* postgres + (string-append "--config-file=" #$config-file) + "-D" #$data-directory))))) + + (define activate + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (let ((user (getpwnam "postgres")) + (initdb (string-append #$postgresql "/bin/initdb"))) + ;; Create db state directory. + (mkdir-p #$data-directory) + (chown #$data-directory (passwd:uid user) (passwd:gid user)) + + ;; Drop privileges and init state directory in a new + ;; process. Wait for it to finish before proceeding. + (match (primitive-fork) + (0 + ;; Exit with a non-zero status code if an exception is thrown. + (dynamic-wind + (const #t) + (lambda () + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + (primitive-exit (system* initdb "-D" #$data-directory))) + (lambda () + (primitive-exit 1)))) + (pid (waitpid pid)))))) + + (mlet %store-monad ((start-script start-script)) + (return + (service + (provision '(postgres)) + (documentation "Run the PostgreSQL daemon.") + (requirement '(user-processes loopback)) + (start #~(make-forkexec-constructor #$start-script)) + (stop #~(make-kill-destructor)) + (activate activate) + (user-groups (list (user-group + (name "postgres") + (system? #t)))) + (user-accounts (list (user-account + (name "postgres") + (group "postgres") + (system? #t) + (comment "PostgreSQL server user") + (home-directory "/var/empty") + (shell + #~(string-append #$shadow "/sbin/nologin"))))))))) -- cgit v1.2.3 From cf2abac8ec07ca421393df755211779b60739ae6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 May 2015 23:07:54 +0200 Subject: artwork: Update to latest version. * gnu/artwork.scm (%artwork-repository): Update. * gnu/services/xorg.scm (%default-slim-theme-name): Change to "0.x". * gnu/system/grub.scm (%background-image): Change to GuixSD-fully-black-4-3.svg. --- gnu/artwork.scm | 4 ++-- gnu/services/xorg.scm | 2 +- gnu/system/grub.scm | 3 ++- 3 files changed, 5 insertions(+), 4 deletions(-) (limited to 'gnu/services') diff --git a/gnu/artwork.scm b/gnu/artwork.scm index c3b1695ba7..94c89143a6 100644 --- a/gnu/artwork.scm +++ b/gnu/artwork.scm @@ -32,9 +32,9 @@ (define %artwork-repository (method git-fetch) (uri (git-reference (url "git://git.savannah.gnu.org/guix/guix-artwork.git") - (commit "61ae7c8"))) + (commit "6998d30"))) (sha256 (base32 - "102fxk2l6b0ibry3n430q8ljhwrnbml9qgalzkz6v09r7sx6a532")))) + "0k7j3pj9s3zqiqmfkapypssvzx3f12yr0cc2rbzxqfii0b4clp1j")))) ;;; artwork.scm ends here diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index c687b46bc2..8fd003f96a 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -192,7 +192,7 @@ (define %default-slim-theme (define %default-slim-theme-name ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that ;; contains the actual theme files. - "0.8") + "0.x") (define* (slim-service #:key (slim slim) (allow-empty-passwords? #t) auto-login? diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 17b08aa9b7..e49b6dbe54 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -80,7 +80,8 @@ (define-record-type* (define %background-image (grub-image (aspect-ratio 4/3) - (file #~(string-append #$%artwork-repository "/grub/GuixSD-4-3.svg")))) + (file #~(string-append #$%artwork-repository + "/grub/GuixSD-fully-black-4-3.svg")))) (define %default-theme ;; Default theme contributed by Felipe López. -- cgit v1.2.3 From 4467be213a93bab8f38ad5e4214dc947b8ca0bd1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 8 May 2015 15:58:59 +0200 Subject: services: Add '%desktop-services'. * gnu/services/desktop.scm (%desktop-services): New variable. * doc/guix.texi (Desktop Services): Document it. --- doc/guix.texi | 23 +++++++++++++++++++++++ gnu/services/desktop.scm | 32 +++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 8e36ce3a5c..7504deab4e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5005,6 +5005,29 @@ usually useful in the context of a ``desktop'' setup---that is, on a machine running a graphical display server, possibly with graphical user interfaces, etc. +To simplify things, the module defines a variable containing the set of +services that users typically expect on a machine with a graphical +environment and networking: + +@defvr {Scheme Variable} %desktop-services +This is a list of services that builds upon @var{%base-services} and +adds or adjust services for a typical ``desktop'' setup. + +In particular, it adds a graphical login manager (@pxref{X Window, +@code{slim-service}}), a network management tool (@pxref{Networking +Services, @code{wicd-service}}), energy and color management services, +an NTP client and an SSH server (@pxref{Networking Services}), the Avahi +daemon, and has the name service switch service configured to be able to +use @code{nss-mdns} (@pxref{Name Service Switch, mDNS}). +@end defvr + +The @var{%desktop-services} variable can be used as the @code{services} +field of an @code{operating-system} declaration (@pxref{operating-system +Reference, @code{services}}). + +The actual service definitions provided by @code{(gnu services desktop)} +are described below. + @deffn {Monadic Procedure} dbus-service @var{services} @ [#:dbus @var{dbus}] Return a service that runs the ``system bus'', using @var{dbus}, with diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 5945f7af18..910dc1f9e0 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -19,17 +19,25 @@ (define-module (gnu services desktop) #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services avahi) + #:use-module (gnu services xorg) + #:use-module (gnu services networking) + #:use-module (gnu services ssh) #:use-module (gnu system shadow) #:use-module (gnu packages glib) #:use-module (gnu packages admin) #:use-module (gnu packages gnome) + #:use-module (gnu packages avahi) + #:use-module (gnu packages wicd) #:use-module (guix monads) #:use-module (guix store) #:use-module (guix gexp) #:use-module (ice-9 match) #:export (dbus-service upower-service - colord-service)) + colord-service + %desktop-services)) ;;; Commentary: ;;; @@ -267,4 +275,26 @@ (define* (colord-service #:key (colord colord)) (shell #~(string-append #$shadow "/sbin/nologin"))))))))) +(define %desktop-services + ;; List of services typically useful for a "desktop" use case. + (cons* (slim-service) + + (avahi-service) + (wicd-service) + (upower-service) + (colord-service) + (dbus-service (list avahi wicd upower colord)) + + (ntp-service) + (lsh-service) + + (map (lambda (mservice) + ;; Provide an nscd ready to use nss-mdns. + (mlet %store-monad ((service mservice)) + (if (memq 'nscd (service-provision service)) + (nscd-service (nscd-configuration) + #:name-services (list nss-mdns)) + mservice))) + %base-services))) + ;;; desktop.scm ends here -- cgit v1.2.3 From 04e4e6ab51f271298f9a001ba5c8c6ae6426fd64 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 8 May 2015 16:26:53 +0200 Subject: doc: Document sessions and ~/.xsession for SLiM. * gnu/services/xorg.scm (slim-service): Document session types and ~/.xsession. * doc/guix.texi (X Window): Adjust accordingly. --- doc/guix.texi | 13 +++++++++++++ gnu/services/xorg.scm | 13 +++++++++++++ 2 files changed, 26 insertions(+) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 7504deab4e..b44811f3cb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4968,6 +4968,19 @@ Return a service that spawns the SLiM graphical login manager, which in turn starts the X display server with @var{startx}, a command as returned by @code{xorg-start-command}. +@cindex X session + +SLiM automatically looks for session types described by the @file{.desktop} +files in @file{/run/current-system/profile/share/xsessions} and allows users +to choose a session from the log-in screen using @kbd{F1}. Packages such as +@var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; +adding them to the system-wide set of packages automatically makes them +available at the log-in screen. + +In addition, @file{~/.xsession} files are honored. When available, +@file{~/.xsession} must be an executable that starts a window manager +and/or other X clients. + When @var{allow-empty-passwords?} is true, allow logins with an empty password. When @var{auto-login?} is true, log in automatically as @var{default-user}. diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 8fd003f96a..4821614ba2 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -207,6 +207,19 @@ (define* (slim-service #:key (slim slim) turn starts the X display server with @var{startx}, a command as returned by @code{xorg-start-command}. +@cindex X session + +SLiM automatically looks for session types described by the @file{.desktop} +files in @file{/run/current-system/profile/share/xsessions} and allows users +to choose a session from the log-in screen using @kbd{F1}. Packages such as +@var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; +adding them to the system-wide set of packages automatically makes them +available at the log-in screen. + +In addition, @file{~/.xsession} files are honored. When available, +@file{~/.xsession} must be an executable that starts a window manager +and/or other X clients. + When @var{allow-empty-passwords?} is true, allow logins with an empty password. When @var{auto-login?} is true, log in automatically as @var{default-user} with @var{auto-login-session}. -- cgit v1.2.3 From 965a7332201af37059bdaf97dc2ec21249bc9d32 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 8 May 2015 16:33:52 +0200 Subject: doc: Document 'avahi-service'. * gnu/services/avahi.scm (avahi-service): Add URL in docstring. * doc/guix.texi (Networking Services): Document it. (Name Service Switch): Fix cross-reference. --- doc/guix.texi | 26 +++++++++++++++++++++++++- gnu/services/avahi.scm | 2 +- 2 files changed, 26 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index b44811f3cb..e2465ee823 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4952,6 +4952,30 @@ This mechanism can prevent programs running locally, such as Web browsers, from accessing Facebook. @end defvr +The @code{(gnu services avahi)} provides the following definition. + +@deffn {Monadic Procedure} avahi-service [#:avahi @var{avahi}] @ + [#:host-name #f] [#:publish? #t] [#:ipv4? #t] @ + [#:ipv6? #t] [#:wide-area? #f] @ + [#:domains-to-browse '()] +Return a service that runs @command{avahi-daemon}, a system-wide +mDNS/DNS-SD responder that allows for service discovery and +"zero-configuration" host name lookups (see @uref{http://avahi.org/}). + +If @var{host-name} is different from @code{#f}, use that as the host name to +publish for this machine; otherwise, use the machine's actual host name. + +When @var{publish?} is true, publishing of host names and services is allowed; +in particular, avahi-daemon will publish the machine's host name and IP +address via mDNS on the local network. + +When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled. + +Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6 +sockets. +@end deffn + + @node X Window @subsubsection X Window @@ -5248,7 +5272,7 @@ configuration file: @dots{} and then refer to @var{%my-base-services} instead of @var{%base-services} in the @code{operating-system} declaration. Lastly, this relies on the availability of the Avahi service -(@pxref{Desktop Services, @code{avahi-service}}). +(@pxref{Networking Services, @code{avahi-service}}). For convenience, the following variables provide typical NSS configurations. diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 0a56f3d7f6..a3ca5ab6fb 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -63,7 +63,7 @@ (define* (avahi-service #:key (avahi avahi) (domains-to-browse '())) "Return a service that runs @command{avahi-daemon}, a system-wide mDNS/DNS-SD responder that allows for service discovery and -\"zero-configuration\" host name lookups. +\"zero-configuration\" host name lookups (see @uref{http://avahi.org/}). If @var{host-name} is different from @code{#f}, use that as the host name to publish for this machine; otherwise, use the machine's actual host name. -- cgit v1.2.3 From c217cbd84d7aee7414945a6cf85e1d704fff6e32 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 9 May 2015 22:28:03 +0200 Subject: services: dhcp-client: Better track dhclient's PID. * gnu/services/networking.scm (dhcp-client-service)[start]: Remove PID-FILE first. When 'call-with-input-file' throws ENOENT, try again. --- gnu/services/networking.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index f9d262d977..33ecf9ccd3 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -165,6 +165,8 @@ (define pid-file (provision '(networking)) (start #~(lambda _ + (false-if-exception (delete-file #$pid-file)) + ;; When invoked without any arguments, 'dhclient' ;; discovers all non-loopback interfaces *that are ;; up*. However, the relevant interfaces are @@ -178,7 +180,19 @@ (define pid-file "-pf" #$pid-file ifaces)))) (and (zero? (cdr (waitpid pid))) - (call-with-input-file #$pid-file read))))) + (let loop () + (catch 'system-error + (lambda () + (call-with-input-file #$pid-file read)) + (lambda args + ;; 'dhclient' returned before PID-FILE + ;; was created, so try again. + (let ((errno (system-error-errno args))) + (if (= ENOENT errno) + (begin + (sleep 1) + (loop)) + (apply throw args)))))))))) (stop #~(make-kill-destructor)))))) (define %ntp-servers -- cgit v1.2.3 From 9bb34f9c9232757f275f458bb2621fe976f8d8fd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 May 2015 23:24:30 +0200 Subject: services: dhcp-client: Turn up the interfaces before calling 'dhclient'. Somehow, as of Linux 4.0.2, the interfaces are down by default, which prevents 'dhclient' from actually using them. * gnu/services/networking.scm (dhcp-client-service): Call 'set-network-interface-up' on each item of IFACES. --- gnu/services/networking.scm | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 33ecf9ccd3..102202c853 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -165,20 +165,24 @@ (define pid-file (provision '(networking)) (start #~(lambda _ - (false-if-exception (delete-file #$pid-file)) - ;; When invoked without any arguments, 'dhclient' ;; discovers all non-loopback interfaces *that are ;; up*. However, the relevant interfaces are ;; typically down at this point. Thus we perform our ;; own interface discovery here. - (let* ((valid? (negate loopback-network-interface?)) - (ifaces (filter valid? - (all-network-interfaces))) - (pid (fork+exec-command - (cons* #$dhclient "-nw" - "-pf" #$pid-file - ifaces)))) + (define valid? + (negate loopback-network-interface?)) + (define ifaces + (filter valid? (all-network-interfaces))) + + ;; XXX: Make sure the interfaces are up so that + ;; 'dhclient' can actually send/receive over them. + (for-each set-network-interface-up ifaces) + + (false-if-exception (delete-file #$pid-file)) + (let ((pid (fork+exec-command + (cons* #$dhclient "-nw" + "-pf" #$pid-file ifaces)))) (and (zero? (cdr (waitpid pid))) (let loop () (catch 'system-error -- cgit v1.2.3 From d1cdd7ba7a7bf6d0ea2ea5466d4bc978586f1f2f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 May 2015 18:02:01 +0200 Subject: services: xorg: Make 'xorg-configuration-file' public. * gnu/services/xorg.scm (xorg-configuration-file): New procedure, with code formerly in 'xorg-start-command'. (xorg-start-command): Remove #:drivers and #:resolutions; add #:configuration-file; use it as well as 'xorg-configuration-file'. --- doc/guix.texi | 16 +++++++++++++--- gnu/services/xorg.scm | 36 ++++++++++++++++++++++-------------- 2 files changed, 35 insertions(+), 17 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 2e245bfcf9..36e68bbe9a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5250,13 +5250,23 @@ The G-Expression denoting the default SLiM theme and its name. @end defvr @deffn {Monadic Procedure} xorg-start-command [#:guile] @ - [#:drivers '()] [#:resolutions '()] [#:xorg-server @var{xorg-server}] + [#:configuration-file #f] [#:xorg-server @var{xorg-server}] Return a derivation that builds a @var{guile} script to start the X server -from @var{xorg-server}. Usually the X server is started by a login manager. +from @var{xorg-server}. @var{configuration-file} is the server configuration +file or a derivation that builds it; when omitted, the result of +@code{xorg-configuration-file} is used. + +Usually the X server is started by a login manager. +@end deffn + +@deffn {Monadic Procedure} xorg-configuration-file @ + [#:drivers '()] [#:resolutions '()] +Return a configuration file for the Xorg server containing search paths for +all the common drivers. @var{drivers} must be either the empty list, in which case Xorg chooses a graphics driver automatically, or a list of driver names that will be tried in -this order---e.g., @code{("modesetting" "vesa")}. +this order---e.g., @code{(\"modesetting\" \"vesa\")}. Likewise, when @var{resolutions} is the empty list, Xorg chooses an appropriate screen resolution; otherwise, it must be a list of diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 4821614ba2..a9afa2fef5 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -37,7 +37,8 @@ (define-module (gnu services xorg) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:export (xorg-start-command + #:export (xorg-configuration-file + xorg-start-command %default-slim-theme %default-slim-theme-name slim-service)) @@ -48,12 +49,9 @@ (define-module (gnu services xorg) ;;; ;;; Code: -(define* (xorg-start-command #:key - (guile (canonical-package guile-2.0)) - (xorg-server xorg-server) - (drivers '()) (resolutions '())) - "Return a derivation that builds a @var{guile} script to start the X server -from @var{xorg-server}. Usually the X server is started by a login manager. +(define* (xorg-configuration-file #:key (drivers '()) (resolutions '())) + "Return a configuration file for the Xorg server containing search paths for +all the common drivers. @var{drivers} must be either the empty list, in which case Xorg chooses a graphics driver automatically, or a list of driver names that will be tried in @@ -62,7 +60,6 @@ (define* (xorg-start-command #:key Likewise, when @var{resolutions} is the empty list, Xorg chooses an appropriate screen resolution; otherwise, it must be a list of resolutions---e.g., @code{((1024 768) (640 480))}." - (define (device-section driver) (string-append " Section \"Device\" @@ -78,15 +75,14 @@ (define (screen-section driver resolutions) SubSection \"Display\" Modes " (string-join (map (match-lambda - ((x y) - (string-append "\"" (number->string x) - "x" (number->string y) "\""))) + ((x y) + (string-append "\"" (number->string x) + "x" (number->string y) "\""))) resolutions)) " EndSubSection EndSection")) - (define (xserver.conf) - (text-file* "xserver.conf" " + (text-file* "xserver.conf" " Section \"Files\" FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" @@ -116,7 +112,19 @@ (define (xserver.conf) drivers) "\n"))) - (mlet %store-monad ((config (xserver.conf))) +(define* (xorg-start-command #:key + (guile (canonical-package guile-2.0)) + configuration-file + (xorg-server xorg-server)) + "Return a derivation that builds a @var{guile} script to start the X server +from @var{xorg-server}. @var{configuration-file} is the server configuration +file or a derivation that builds it; when omitted, the result of +@code{xorg-configuration-file} is used. + +Usually the X server is started by a login manager." + (mlet %store-monad ((config (if configuration-file + (return configuration-file) + (xorg-configuration-file)))) (define script ;; Write a small wrapper around the X server. #~(begin -- cgit v1.2.3 From 12422c9d3872f66c4eac5eb65824238c3e09be1a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 May 2015 18:12:28 +0200 Subject: services: xorg: Allow extra config text to be added verbatim. * gnu/services/xorg.scm (xorg-configuration-file): Add #:extra-config and honor it. * doc/guix.texi (X Window): Adjust accordingly. --- doc/guix.texi | 6 +++++- gnu/services/xorg.scm | 18 +++++++++++++----- 2 files changed, 18 insertions(+), 6 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 36e68bbe9a..fd0d29cb8f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5260,7 +5260,7 @@ Usually the X server is started by a login manager. @end deffn @deffn {Monadic Procedure} xorg-configuration-file @ - [#:drivers '()] [#:resolutions '()] + [#:drivers '()] [#:resolutions '()] [#:extra-config '()] Return a configuration file for the Xorg server containing search paths for all the common drivers. @@ -5271,6 +5271,10 @@ this order---e.g., @code{(\"modesetting\" \"vesa\")}. Likewise, when @var{resolutions} is the empty list, Xorg chooses an appropriate screen resolution; otherwise, it must be a list of resolutions---e.g., @code{((1024 768) (640 480))}. + +Last, @var{extra-config} is a list of strings or objects appended to the +@code{text-file*} argument list. It is used to pass extra text to be added +verbatim to the configuration file. @end deffn @node Desktop Services diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index a9afa2fef5..e43bfcffe0 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -49,7 +49,8 @@ (define-module (gnu services xorg) ;;; ;;; Code: -(define* (xorg-configuration-file #:key (drivers '()) (resolutions '())) +(define* (xorg-configuration-file #:key (drivers '()) (resolutions '()) + (extra-config '())) "Return a configuration file for the Xorg server containing search paths for all the common drivers. @@ -59,7 +60,11 @@ (define* (xorg-configuration-file #:key (drivers '()) (resolutions '())) Likewise, when @var{resolutions} is the empty list, Xorg chooses an appropriate screen resolution; otherwise, it must be a list of -resolutions---e.g., @code{((1024 768) (640 480))}." +resolutions---e.g., @code{((1024 768) (640 480))}. + +Last, @var{extra-config} is a list of strings or objects appended to the +@code{text-file*} argument list. It is used to pass extra text to be added +verbatim to the configuration file." (define (device-section driver) (string-append " Section \"Device\" @@ -82,7 +87,7 @@ (define (screen-section driver resolutions) EndSubSection EndSection")) - (text-file* "xserver.conf" " + (apply text-file* "xserver.conf" " Section \"Files\" FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" @@ -107,10 +112,13 @@ (define (screen-section driver resolutions) Option \"AllowMouseOpenFail\" \"on\" EndSection " - (string-join (map device-section drivers) "\n") + (string-join (map device-section drivers) "\n") "\n" (string-join (map (cut screen-section <> resolutions) drivers) - "\n"))) + "\n") + + "\n" + extra-config)) (define* (xorg-start-command #:key (guile (canonical-package guile-2.0)) -- cgit v1.2.3 From 1eca6c36adc00d88e6f29744aa2402f2a006be04 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 May 2015 22:22:12 +0200 Subject: services: xorg: Assume STARTX is a regular value. * gnu/services/xorg.scm (slim-service): Expect STARTX to be a regular value, not a monadic value. --- gnu/services/xorg.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index e43bfcffe0..7c875a1ae1 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -246,7 +246,9 @@ (define* (slim-service #:key (slim slim) theme." (define (slim.cfg) - (mlet %store-monad ((startx (or startx (xorg-start-command))) + (mlet %store-monad ((startx (if startx + (return startx) + (xorg-start-command))) (xinitrc (xinitrc #:fallback-session auto-login-session))) (text-file* "slim.cfg" " -- cgit v1.2.3 From c2ee19e6850960ee613c43af3937b1ce11d663f3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 May 2015 22:32:34 +0200 Subject: services: xorg: Add xf86-input-libinput to the server's module path. * gnu/services/xorg.scm (xorg-configuration-file): Add XF86-INPUT-LIBINPUT. --- gnu/services/xorg.scm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 7c875a1ae1..9ee88170e4 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -99,6 +99,12 @@ (define (screen-section driver resolutions) ModulePath \"" xf86-video-nouveau "/lib/xorg/modules/drivers\" ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\" ModulePath \"" xf86-video-sis "/lib/xorg/modules/drivers\" + + # Libinput is the new thing and is recommended over evdev/synaptics + # by those who know: + # . + ModulePath \"" xf86-input-libinput "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-evdev "/lib/xorg/modules/input\" ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" -- cgit v1.2.3 From 60a56db0074259355a590851131aa23e1549fd8c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 May 2015 23:24:49 +0200 Subject: services: swap: Use 'restart-on-EINTR'. * gnu/services/base.scm (swap-service)[start, stop]: Use 'restart-on-EINTR'. * guix/build/syscalls.scm (swapoff): Fix typo in 'throw' arguments. --- gnu/services/base.scm | 4 ++-- guix/build/syscalls.scm | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 697b9395c2..d5744204d9 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -851,10 +851,10 @@ (define requirement (requirement `(udev ,@requirement)) (documentation "Enable the given swap device.") (start #~(lambda () - (swapon #$device) + (restart-on-EINTR (swapon #$device)) #t)) (stop #~(lambda _ - (swapoff #$device) + (restart-on-EINTR (swapoff #$device)) #f)) (respawn? #f))))) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 9ec7e8b4a9..3585bf27a8 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -218,7 +218,7 @@ (define swapoff (let ((ret (proc (string->pointer device))) (err (errno))) (unless (zero? ret) - (throw 'system-error "swapff" "~S: ~A" + (throw 'system-error "swapoff" "~S: ~A" (list device (strerror err)) (list err))))))) -- cgit v1.2.3