Merge branch 'master' into staging

9 files changed, 84 insertions, 46 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 27eae75c46..bb11732de2 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2918,17 +2918,6 @@ to handle."
      "user = " default-session-user "\n"
      "command = " default-session-command "\n")))
 
-(define %greetd-accounts
-  (list (user-account
-         (name "greeter")
-         (group "greeter")
-         ;; video group is required for graphical greeters.
-         (supplementary-groups '("video"))
-         (system? #t))
-        (user-group
-         (name "greeter")
-         (system? #t))))
-
 (define %greetd-file-systems
   (list (file-system
           (device "none")
@@ -2956,7 +2945,16 @@ to handle."
   greetd-configuration?
   (motd greetd-motd (default %default-motd))
   (allow-empty-passwords? greetd-allow-empty-passwords? (default #t))
-  (terminals greetd-terminals (default '())))
+  (terminals greetd-terminals (default '()))
+  (greeter-supplementary-groups greetd-greeter-supplementary-groups (default '())))
+
+(define (greetd-accounts config)
+  (list (user-group (name "greeter") (system? #t))
+        (user-account
+         (name "greeter")
+         (group "greeter")
+         (supplementary-groups (greetd-greeter-supplementary-groups config))
+         (system? #t))))
 
 (define (make-greetd-pam-mount-conf-file config)
   (computed-file
@@ -3033,7 +3031,7 @@ mount/unmount /run/user/<uid> directory for user and @code{greetd}
 login manager daemon.")
    (extensions
     (list
-     (service-extension account-service-type (const %greetd-accounts))
+     (service-extension account-service-type greetd-accounts)
      (service-extension file-system-service-type (const %greetd-file-systems))
      (service-extension etc-service-type greetd-etc-service)
      (service-extension pam-root-service-type greetd-pam-service)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 3007e8de35..83da63c1b3 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -57,6 +57,9 @@
             serialize-configuration
             define-maybe
             define-maybe/no-serialization
+            %unset-value
+            maybe-value
+            maybe-value-set?
             generate-documentation
             configuration->documentation
             empty-serializer
@@ -142,7 +145,8 @@ does not have a default value" field kind)))
                                     (id #'stem #'serialize-maybe- #'stem))))
        #`(begin
            (define (maybe-stem? val)
-             (or (eq? val 'unset) (stem? val)))
+             (or (not (maybe-value-set? val))
+                 (stem? val)))
            #,@(if serialize?
                   (list #'(define (serialize-maybe-stem field-name val)
                             (if (stem? val)
@@ -170,10 +174,10 @@ does not have a default value" field kind)))
      (values #'(field-type def)))
     ((field-type)
      (identifier? #'field-type)
-     (values #'(field-type 'unset)))
+     (values #'(field-type %unset-value)))
     (field-type
      (identifier? #'field-type)
-     (values #'(field-type 'unset)))))
+     (values #'(field-type %unset-value)))))
 
 (define (define-configuration-helper serialize? serializer-prefix syn)
   (syntax-case syn ()
@@ -260,11 +264,10 @@ does not have a default value" field kind)))
                       (default-value-thunk
                         (lambda ()
                           (display '#,(id #'stem #'% #'stem))
-                          (if (eq? (syntax->datum field-default)
-                                   'unset)
+                          (if (maybe-value-set? (syntax->datum field-default))
+                              field-default
                               (configuration-missing-default-value
-                               '#,(id #'stem #'% #'stem) 'field)
-                              field-default)))
+                               '#,(id #'stem #'% #'stem) 'field))))
                       (documentation doc))
                      ...))))))))
 
@@ -300,6 +303,29 @@ does not have a default value" field kind)))
 (define (empty-serializer field-name val) "")
 (define serialize-package empty-serializer)
 
+;; Ideally this should be an implementation detail, but we export it
+;; to provide a simpler API that enables unsetting a configuration
+;; field that has a maybe type, but also a default value.  We give it
+;; a value that sticks out to the reader when something goes wrong.
+;;
+;; An example use-case would be something like a network application
+;; that uses a default port, but the field can explicitly be unset to
+;; request a random port at startup.
+(define %unset-value '%unset-marker%)
+
+(define (maybe-value-set? value)
+  "Predicate to check whether a 'maybe' value was explicitly provided."
+  (not (eq? %unset-value value)))
+
+;; Ideally there should be a compiler macro for this predicate, that expands
+;; to a conditional that only instantiates the default value when needed.
+(define* (maybe-value value #:optional (default #f))
+  "Returns VALUE, unless it is the unset value, in which case it returns
+DEFAULT."
+  (if (maybe-value-set? value)
+      value
+      default))
+
 ;; A little helper to make it easier to document all those fields.
 (define (generate-documentation documentation documentation-name)
   (define (str x) (object->string x))
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index f891d1b5cc..f60365abac 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -13,7 +13,7 @@
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
-;;; Copyright © 2021 muradm <mail@muradm.net>
+;;; Copyright © 2021, 2022 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -69,6 +69,7 @@
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix store)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
@@ -1643,12 +1644,19 @@ or setting its password with passwd.")))
 ;;; seatd-service-type -- minimal seat management daemon
 ;;;
 
+(define (seatd-group-sanitizer group-or-name)
+  (match group-or-name
+    ((? user-group? group) group)
+    ((? string? group-name) (user-group (name group-name) (system? #t)))
+    (_ (leave (G_ "seatd: '~a' is not a valid group~%") group-or-name))))
+
 (define-record-type* <seatd-configuration> seatd-configuration
   make-seatd-configuration
   seatd-configuration?
   (seatd seatd-package (default seatd))
-  (user seatd-user (default "root"))
-  (group seatd-group (default "users"))
+  (group seatd-group                    ; string | <user-group>
+         (default "seat")
+         (sanitize seatd-group-sanitizer))
   (socket seatd-socket (default "/run/seatd.sock"))
   (logfile seatd-logfile (default "/var/log/seatd.log"))
   (loglevel seatd-loglevel (default "info")))
@@ -1662,8 +1670,7 @@ or setting its password with passwd.")))
          (provision '(seatd elogind))
          (start #~(make-forkexec-constructor
                    (list #$(file-append (seatd-package config) "/bin/seatd")
-                         "-u" #$(seatd-user config)
-                         "-g" #$(seatd-group config))
+                         "-g" #$(user-group-name (seatd-group config)))
                    #:environment-variables
                    (list (string-append "SEATD_LOGLEVEL="
                                         #$(seatd-loglevel config))
@@ -1672,9 +1679,12 @@ or setting its password with passwd.")))
                    #:log-file #$(seatd-logfile config)))
          (stop #~(make-kill-destructor)))))
 
+(define seatd-accounts
+  (match-lambda (($ <seatd-configuration> _ group) (list group))))
+
 (define seatd-environment
   (match-lambda
-    (($ <seatd-configuration> _ _ _ socket)
+    (($ <seatd-configuration> _ _ socket)
      `(("SEATD_SOCK" . ,socket)))))
 
 (define seatd-service-type
@@ -1685,6 +1695,7 @@ to shared devices (graphics, input), without requiring the
 applications needing access to be root.")
    (extensions
     (list
+     (service-extension account-service-type seatd-accounts)
      (service-extension session-environment-service-type seatd-environment)
      ;; TODO: once cgroups is separate dependency we should not mount it here
      ;; for now it is mounted here, because elogind mounts it
diff --git a/gnu/services/file-sharing.scm b/gnu/services/file-sharing.scm
index 5df8b0d597..75e99f20b7 100644
--- a/gnu/services/file-sharing.scm
+++ b/gnu/services/file-sharing.scm
@@ -114,10 +114,7 @@ type generated and used by Transmission clients, suitable for passing to the
 ;; name-value pair for the JSON builder.
 (set! serialize-maybe-string
   (lambda (field-name val)
-    (serialize-string field-name
-                      (if (eq? val 'unset)
-                          ""
-                          val))))
+    (serialize-string field-name (maybe-value val ""))))
 
 (define (string-list? val)
   (and (list? val)
@@ -180,9 +177,9 @@ type generated and used by Transmission clients, suitable for passing to the
 (define-maybe file-object)
 (set! serialize-maybe-file-object
   (lambda (field-name val)
-    (if (eq? val 'unset)
-        (serialize-string field-name "")
-        (serialize-file-object field-name val))))
+    (if (maybe-value-set? val)
+        (serialize-file-object field-name val)
+        (serialize-string field-name ""))))
 
 (define (file-object-list? val)
   (and (list? val)
diff --git a/gnu/services/getmail.scm b/gnu/services/getmail.scm
index ce124f6b11..0a1c34cfd3 100644
--- a/gnu/services/getmail.scm
+++ b/gnu/services/getmail.scm
@@ -111,10 +111,10 @@
    "The type of mail retriever to use.  Valid values include
 @samp{passwd} and @samp{static}.")
   (server
-   (string 'unset)
+   string
    "Name or IP address of the server to retrieve mail from.")
   (username
-   (string 'unset)
+   string
    "Username to login to the mail server with.")
   (port
    (non-negative-integer #f)
@@ -143,7 +143,7 @@
 
 (define-configuration getmail-destination-configuration
   (type
-   (string 'unset)
+   string
    "The type of mail destination.  Valid values include @samp{Maildir},
 @samp{Mboxrd} and @samp{MDA_external}.")
   (path
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index f845c1bd89..c3c7872734 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -39,6 +39,7 @@
 
 
 
+;; TODO Use %unset-value and the define-maybe infrastructure.
 (define unset-field (list 'unset-field))
 
 (define (predicate/unset pred)
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 00a1c80a14..02712ede7c 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -90,7 +90,12 @@
                      ((new-def ...)
                       (map (lambda (def target)
                              (if (eq? 'common (syntax->datum target))
-                                 #''unset def))
+                                 ;; TODO Use the %unset-value variable, or
+                                 ;; even better just simplify this so that it
+                                 ;; doesn't interfere with
+                                 ;; define-configuration and define-maybe
+                                 ;; internals.
+                                 #''%unset-marker% def))
                            #'(def ...) #'(target ...)))
                      ((new-doc ...)
                       (map (lambda (doc target)
@@ -200,7 +205,7 @@
 (define-maybe file-object-list)
 
 (define (raw-content? val)
-  (not (eq? val 'unset)))
+  (maybe-value-set? val))
 (define (serialize-raw-content field-name val)
   val)
 (define-maybe raw-content)
@@ -474,12 +479,12 @@ by the Prosody service.  See @url{https://prosody.im/doc/logging}."
      global)
 
     (http-max-content-size
-     (maybe-non-negative-integer 'unset)
+     (maybe-non-negative-integer %unset-value)
      "Maximum allowed size of the HTTP body (in bytes)."
      common)
 
     (http-external-url
-     (maybe-string 'unset)
+     (maybe-string %unset-value)
      "Some modules expose their own URL in various ways.  This URL is built
 from the protocol, host and port used.  If Prosody sits behind a proxy, the
 public URL will be @code{http-external-url} instead.  See
@@ -556,7 +561,7 @@ support.  To add an external component, you simply fill the hostname field.  See
      int-component)
 
     (mod-muc
-     (maybe-mod-muc-configuration 'unset)
+     (maybe-mod-muc-configuration %unset-value)
      "Multi-user chat (MUC) is Prosody's module for allowing you to create
 hosted chatrooms/conferences for XMPP users.
 
@@ -573,7 +578,7 @@ See also @url{https://prosody.im/doc/modules/mod_muc}."
      ext-component)
 
     (raw-content
-     (maybe-raw-content 'unset)
+     (maybe-raw-content %unset-value)
      "Raw content that will be added to the configuration file."
      common)))
 
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 3c6395b6ca..9d85728371 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -772,7 +772,7 @@ logging is disabled.")
 network.  A specific port value can be provided by appending the @code{:PORT}
 suffix.  By default, it uses the Jami bootstrap nodes, but any host can be
 specified here.  It's also possible to disable bootstrapping by explicitly
-setting this field to the @code{'unset} value.")
+setting this field to @code{%unset-value}.")
   (port
    (maybe-number 4222)
    "The UDP port to bind to.  When left unspecified, an available port is
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index 7152f3b38d..3d855221e5 100644
--- a/gnu/services/telephony.scm
+++ b/gnu/services/telephony.scm
@@ -307,7 +307,7 @@ CONFIG, a <jami-configuration> object."
          (dbus (jami-configuration-dbus config))
          (dbus-daemon (file-append dbus "/bin/dbus-daemon"))
          (accounts (jami-configuration-accounts config))
-         (declarative-mode? (not (eq? 'unset accounts))))
+         (declarative-mode? (maybe-value-set? accounts)))
 
     (with-extensions (list guile-packrat ;used by guile-ac-d-bus
                            guile-ac-d-bus
@@ -649,7 +649,7 @@ argument, either a registered username or the fingerprint of the account.")
                                           account-details)
                            (let ((username (archive-name->username
                                             archive)))
-                             (when (not (eq? 'unset allowed-contacts))
+                             (when (not (eq? '#$%unset-value allowed-contacts))
                                ;; Reject calls from unknown contacts.
                                (set-account-details
                                 '(("DHT.PublicInCalls" . "false")) username)
@@ -659,7 +659,7 @@ argument, either a registered username or the fingerprint of the account.")
                                ;; Add allowed ones.
                                (for-each (cut add-contact <> username)
                                          allowed-contacts))
-                             (when (not (eq? 'unset moderators))
+                             (when (not (eq? '#$%unset-value moderators))
                                ;; Disable the 'AllModerators' property.
                                (set-all-moderators #f username)
                                ;; Remove all moderators.