diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 32 | ||||
| -rw-r--r-- | gnu/services/cups.scm | 12 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 65 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 14 | ||||
| -rw-r--r-- | gnu/services/syncthing.scm | 89 | ||||
| -rw-r--r-- | gnu/services/virtualization.scm | 8 | ||||
| -rw-r--r-- | gnu/services/web.scm | 27 |
7 files changed, 201 insertions, 46 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 945b546607..f6a490f712 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015, 2016, 2020 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> @@ -279,7 +279,9 @@ system objects."))) (define root-file-system-service-type (shepherd-service-type 'root-file-system - (const %root-file-system-shepherd-service))) + (const %root-file-system-shepherd-service) + (description "Take care of syncing the root file +system and of remounting it read-only when the system shuts down."))) (define (root-file-system-service) "Return a service whose sole purpose is to re-mount read-only the root file @@ -570,7 +572,9 @@ down."))) (requirement '(udev)) (provision '(trng)) (start #~(make-forkexec-constructor '#$rngd-command)) - (stop #~(make-kill-destructor)))))) + (stop #~(make-kill-destructor)))) + (description "Run the @command{rngd} random number generation daemon to +supply entropy to the kernel's pool."))) (define* (rngd-service #:key (rng-tools rng-tools) @@ -597,7 +601,8 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (provision '(host-name)) (start #~(lambda _ (sethostname #$name))) - (one-shot? #t))))) + (one-shot? #t))) + (description "Initialize the machine's host name."))) (define (host-name-service name) "Return a service that sets the host name to @var{name}." @@ -626,7 +631,8 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (display 1 port)))) #t)) (stop #~(const #f))))) - #t)) ;default to UTF-8 + #t ;default to UTF-8 + (description "Ensure the Linux virtual terminals run in UTF-8 mode."))) (define console-keymap-service-type (shepherd-service-type @@ -638,7 +644,10 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (start #~(lambda _ (zero? (system* #$(file-append kbd "/bin/loadkeys") #$@files)))) - (respawn? #f))))) + (respawn? #f))) + (description "@emph{This service is deprecated in favor of the +@code{keyboard-layout} field of @code{operating-system}.} Load the given list +of console keymaps with @command{loadkeys}."))) (define-deprecated (console-keymap-service #:rest files) #f @@ -1341,7 +1350,9 @@ Service Switch}, for an example." (pid (spawn))) (umask mask) pid)))) - (stop #~(make-kill-destructor)))))) + (stop #~(make-kill-destructor)))) + (description "Run the syslog daemon, @command{syslogd}, which is +responsible for logging system messages."))) ;; Snippet adapted from the GNU inetutils manual. (define %default-syslog.conf @@ -2207,7 +2218,8 @@ instance." (when device (restart-on-EINTR (swapoff device))) #f))) - (respawn? #f)))))) + (respawn? #f)))) + (description "Turn on the virtual memory swap area."))) (define (swap-service device) "Return a service that uses @var{device} as a swap device." @@ -2321,7 +2333,9 @@ This service is not part of @var{%base-services}." (requirement '(user-processes udev dbus-system)) (provision (list (symbol-append 'term- (string->symbol virtual-terminal)))) (start #~(make-forkexec-constructor #$kmscon-command)) - (stop #~(make-kill-destructor))))))) + (stop #~(make-kill-destructor))))) + (description "Start the @command{kmscon} virtual terminal emulator for the +Linux @dfn{kernel mode setting} (KMS)."))) (define-record-type* <static-networking> static-networking make-static-networking diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm index e8957c6859..17ed04e58b 100644 --- a/gnu/services/cups.scm +++ b/gnu/services/cups.scm @@ -32,7 +32,7 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module (ice-9 match) - #:use-module ((srfi srfi-1) #:select (append-map)) + #:use-module ((srfi srfi-1) #:select (append-map find)) #:export (cups-service-type cups-configuration opaque-cups-configuration @@ -50,7 +50,13 @@ ;;; Code: (define %cups-accounts - (list (user-group (name "lp") (system? #t)) + (list (or + ;; The "lp" group should already exist; try to reuse it. + (find (lambda (group) + (and (user-group? group) + (string=? (user-group-name group) "lp"))) + %base-groups) + (user-group (name "lp") (system? #t))) (user-group (name "lpadmin") (system? #t)) (user-account (name "lp") @@ -482,7 +488,7 @@ programs.") (package cups) "The CUPS package.") (extensions - (package-list (list cups-filters epson-inkjet-printer-escpr + (package-list (list brlaser cups-filters epson-inkjet-printer-escpr foomatic-filters hplip-minimal splix)) "Drivers and other extensions to the CUPS package.") (files-configuration diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 9ec0f6a9ca..a4d4ac0646 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 John Darrington <jmd@gnu.org> @@ -14,6 +14,7 @@ ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org> ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ #:use-module (gnu packages admin) #:use-module (gnu packages base) #:use-module (gnu packages bash) + #:use-module (gnu packages cluster) #:use-module (gnu packages connman) #:use-module (gnu packages freedesktop) #:use-module (gnu packages linux) @@ -192,7 +194,11 @@ yggdrasil-configuration-log-level yggdrasil-configuration-log-to yggdrasil-configuration-json-config - yggdrasil-configuration-package)) + yggdrasil-configuration-package + + keepalived-configuration + keepalived-configuration? + keepalived-service-type)) ;;; Commentary: ;;; @@ -277,7 +283,9 @@ fe80::1%lo0 apps.facebook.com\n") (and (zero? (cdr (waitpid pid))) (read-pid-file #$pid-file))))) (stop #~(make-kill-destructor)))) - isc-dhcp)) + isc-dhcp + (description "Run @command{dhcp}, a Dynamic Host Configuration +Protocol (DHCP) client, on all the non-loopback network interfaces."))) (define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp)) dhcp-client-service-type @@ -552,9 +560,7 @@ make an initial adjustment of more than 1,000 seconds." (constraint-from openntpd-constraint-from (default '())) (constraints-from openntpd-constraints-from - (default '())) - (allow-large-adjustment? openntpd-allow-large-adjustment? - (default #f))) ; upstream default + (default '()))) (define (openntpd-configuration->string config) @@ -586,8 +592,7 @@ make an initial adjustment of more than 1,000 seconds." "\n"))) ;add a trailing newline (define (openntpd-shepherd-service config) - (let ((openntpd (openntpd-configuration-openntpd config)) - (allow-large-adjustment? (openntpd-allow-large-adjustment? config))) + (let ((openntpd (openntpd-configuration-openntpd config))) (define ntpd.conf (plain-file "ntpd.conf" (openntpd-configuration->string config))) @@ -599,10 +604,7 @@ make an initial adjustment of more than 1,000 seconds." (start #~(make-forkexec-constructor (list (string-append #$openntpd "/sbin/ntpd") "-f" #$ntpd.conf - "-d" ;; don't daemonize - #$@(if allow-large-adjustment? - '("-s") - '())) + "-d") ;; don't daemonize ;; When ntpd is daemonized it repeatedly tries to respawn ;; while running, leading shepherd to disable it. To ;; prevent spamming stderr, redirect output to logfile. @@ -1865,4 +1867,43 @@ See yggdrasil -genconf for config options.") (service-extension profile-service-type (compose list yggdrasil-configuration-package)))))) + +;;; +;;; Keepalived +;;; + +(define-record-type* <keepalived-configuration> + keepalived-configuration make-keepalived-configuration + keepalived-configuration? + (keepalived keepalived-configuration-keepalived ;<package> + (default keepalived)) + (config-file keepalived-configuration-config-file ;file-like + (default #f))) + +(define keepalived-shepherd-service + (match-lambda + (($ <keepalived-configuration> keepalived config-file) + (list + (shepherd-service + (provision '(keepalived)) + (documentation "Run keepalived.") + (requirement '(loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$keepalived "/sbin/keepalived") + "--dont-fork" "--log-console" "--log-detail" + "--pid=/var/run/keepalived.pid" + (string-append "--use-file=" #$config-file)) + #:pid-file "/var/run/keepalived.pid" + #:log-file "/var/log/keepalived.log")) + (respawn? #f) + (stop #~(make-kill-destructor))))))) + +(define keepalived-service-type + (service-type (name 'keepalived) + (extensions (list (service-extension shepherd-root-service-type + keepalived-shepherd-service))) + (description + "Run @uref{https://www.keepalived.org/, Keepalived} +routing software."))) + ;;; networking.scm ends here diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 1faeb350df..d2f9776288 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> @@ -119,23 +119,25 @@ ensuring they are started and stopped in the right order."))) (service shepherd-root-service-type '())) (define-syntax shepherd-service-type - (syntax-rules () + (syntax-rules (description) "Return a <service-type> denoting a simple shepherd service--i.e., the type for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else. When DEFAULT is given, use it as the service's default value." - ((_ service-name proc default) + ((_ service-name proc default (description text)) (service-type (name service-name) (extensions (list (service-extension shepherd-root-service-type (compose list proc)))) - (default-value default))) - ((_ service-name proc) + (default-value default) + (description text))) + ((_ service-name proc (description text)) (service-type (name service-name) (extensions (list (service-extension shepherd-root-service-type - (compose list proc)))))))) + (compose list proc)))) + (description text))))) (define %default-imported-modules ;; Default set of modules imported for a service's consumption. diff --git a/gnu/services/syncthing.scm b/gnu/services/syncthing.scm new file mode 100644 index 0000000000..12ebe7c107 --- /dev/null +++ b/gnu/services/syncthing.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu services syncthing) + #:use-module (gnu packages syncthing) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (syncthing-configuration + syncthing-configuration? + syncthing-service-type)) + +;;; Commentary: +;;; +;;; This module provides a service definition for the syncthing service. +;;; +;;; Code: + +(define-record-type* <syncthing-configuration> + syncthing-configuration make-syncthing-configuration + syncthing-configuration? + (syncthing syncthing-configuration-syncthing ;<package> + (default syncthing)) + (arguments syncthing-configuration-arguments ;list of strings + (default '())) + (logflags syncthing-configuration-logflags ;number + (default 0)) + (user syncthing-configuration-user ;string + (default #f)) + (group syncthing-configuration-group ;string + (default "users")) + (home syncthing-configuration-home ;string + (default #f))) + +(define syncthing-shepherd-service + (match-lambda + (($ <syncthing-configuration> syncthing arguments logflags user group home) + (list + (shepherd-service + (provision (list (string->symbol (string-append "syncthing-" user)))) + (documentation "Run syncthing.") + (requirement '(loopback)) + (start #~(make-forkexec-constructor + (append (list (string-append #$syncthing "/bin/syncthing") + "-no-browser" + "-no-restart" + (string-append "-logflags=" (number->string #$logflags))) + '#$arguments) + #:user #$user + #:group #$group + #:environment-variables + (append (list (string-append "HOME=" (or #$home (passwd:dir (getpw #$user)))) + "SSL_CERT_DIR=/etc/ssl/certs" + "SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt") + (remove (lambda (str) + (or (string-prefix? "HOME=" str) + (string-prefix? "SSL_CERT_DIR=" str) + (string-prefix? "SSL_CERT_FILE=" str))) + (environ))))) + (respawn? #f) + (stop #~(make-kill-destructor))))))) + +(define syncthing-service-type + (service-type (name 'syncthing) + (extensions (list (service-extension shepherd-root-service-type + syncthing-shepherd-service))) + (description + "Run @uref{https://github.com/syncthing/syncthing, Syncthing} +decentralized continuous file system synchronization."))) + +;;; syncthing.scm ends here diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index f435630faf..a45da14a80 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com> ;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2020,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -717,7 +717,7 @@ potential infinite waits blocking libvirt.")) (platforms qemu-binfmt-configuration-platforms (default '())) ;safest default (guix-support? qemu-binfmt-configuration-guix-support? - (default #f))) + (default #t))) (define (qemu-platform->binfmt qemu platform) "Return a gexp that evaluates to a binfmt string for PLATFORM, using the @@ -917,7 +917,9 @@ is added to the OS specified in CONFIG." (disk-size (hurd-vm-configuration-disk-size config)) (type (lookup-image-type-by-name 'hurd-qcow2)) (os->image (image-type-constructor type))) - (system-image (os->image os)))) + (system-image + (image (inherit (os->image os)) + (size disk-size))))) (define (hurd-vm-port config base) "Return the forwarded vm port for this childhurd config." diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 855f4e649b..ff7b262b6a 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -922,19 +922,20 @@ of index files." (define php-fpm-accounts (match-lambda (($ <php-fpm-configuration> php socket user group socket-user socket-group _ _ _ _ _ _) - (list - (user-group (name "php-fpm") (system? #t)) - (user-group - (name group) - (system? #t)) - (user-account - (name user) - (group group) - (supplementary-groups '("php-fpm")) - (system? #t) - (comment "php-fpm daemon user") - (home-directory "/var/empty") - (shell (file-append shadow "/sbin/nologin"))))))) + `(,@(if (equal? group "php-fpm") + '() + (list (user-group (name "php-fpm") (system? #t)))) + ,(user-group + (name group) + (system? #t)) + ,(user-account + (name user) + (group group) + (supplementary-groups '("php-fpm")) + (system? #t) + (comment "php-fpm daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))))) (define (default-php-fpm-config socket user group socket-user socket-group pid-file log-file pm display-errors timezone workers-log-file) |