Merge branch 'master' into staging

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)