Merge branch 'staging' into core-updates

10 files changed, 92 insertions, 49 deletions

diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 0b4ecaeb83..252bedb0bd 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -40,6 +40,7 @@
             log-rotation-files
             log-rotation-options
             log-rotation-post-rotate
+            %default-log-rotation-options
 
             rottlog-configuration
             rottlog-configuration?
@@ -82,7 +83,12 @@
   (post-rotate log-rotation-post-rotate           ;#f | gexp
                (default #f))
   (options     log-rotation-options               ;list of strings
-               (default '())))
+               (default %default-log-rotation-options)))
+
+(define %default-log-rotation-options
+  ;; Default log rotation options: append ".gz" to file names.
+  '("storefile @FILENAME.@COMP_EXT"
+    "notifempty"))
 
 (define %rotated-files
   ;; Syslog files subject to rotation.
@@ -93,18 +99,21 @@
   (list (log-rotation                             ;syslog files
          (files %rotated-files)
 
-         (options '(;; Run post-rotate once per rotation
+         (frequency 'weekly)
+         (options `(;; These files are worth keeping for a few weeks.
+                    "rotate 16"
+                    ;; Run post-rotate once per rotation
                     "sharedscripts"
-                    ;; Append .gz to rotated files
-                    "storefile @FILENAME.@COMP_EXT"))
+
+                    ,@%default-log-rotation-options))
          ;; Restart syslogd after rotation.
          (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
                                      read)))
                           (kill pid SIGHUP))))
         (log-rotation
          (files '("/var/log/guix-daemon.log"))
-         (options '("rotate 4"                    ;don't keep too many of them
-                    "storefile @FILENAME.@COMP_EXT")))))
+         (options `("rotate 4"                    ;don't keep too many of them
+                    ,@%default-log-rotation-options)))))
 
 (define (log-rotation->config rotation)
   "Return a string-valued gexp representing the rottlog configuration snippet
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index e3c101d042..3007e8de35 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
@@ -142,8 +142,7 @@ does not have a default value" field kind)))
                                     (id #'stem #'serialize-maybe- #'stem))))
        #`(begin
            (define (maybe-stem? val)
-             (or (unspecified? val)
-                 (stem? val)))
+             (or (eq? val 'unset) (stem? val)))
            #,@(if serialize?
                   (list #'(define (serialize-maybe-stem field-name val)
                             (if (stem? val)
@@ -171,10 +170,10 @@ does not have a default value" field kind)))
      (values #'(field-type def)))
     ((field-type)
      (identifier? #'field-type)
-     (values #'(field-type *unspecified*)))
+     (values #'(field-type 'unset)))
     (field-type
      (identifier? #'field-type)
-     (values #'(field-type *unspecified*)))))
+     (values #'(field-type 'unset)))))
 
 (define (define-configuration-helper serialize? serializer-prefix syn)
   (syntax-case syn ()
@@ -262,7 +261,7 @@ does not have a default value" field kind)))
                         (lambda ()
                           (display '#,(id #'stem #'% #'stem))
                           (if (eq? (syntax->datum field-default)
-                                   '*unspecified*)
+                                   'unset)
                               (configuration-missing-default-value
                                '#,(id #'stem #'% #'stem) 'field)
                               field-default)))
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index d666d6243b..52de5ca7c0 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
-;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
@@ -305,7 +305,8 @@
          (files (list (cuirass-configuration-log-file config)
                       (cuirass-configuration-web-log-file config)))
          (frequency 'weekly)
-         (options '("rotate 40")))))              ;worth keeping
+         (options `("rotate 40"                   ;worth keeping
+                    ,@%default-log-rotation-options)))))
 
 (define cuirass-service-type
   (service-type
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 29a3722f1b..f891d1b5cc 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
-;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2017 Nikita <nikita@n0.is>
 ;;; Copyright © 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
@@ -971,7 +971,7 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
   (handle-lid-switch-docked         elogind-handle-lid-switch-docked
                                     (default 'ignore))
   (handle-lid-switch-external-power elogind-handle-lid-switch-external-power
-                                    (default 'ignore))
+                                    (default *unspecified*))
   (power-key-ignore-inhibited?      elogind-power-key-ignore-inhibited?
                                     (default #f))
   (suspend-key-ignore-inhibited?    elogind-suspend-key-ignore-inhibited?
@@ -1032,7 +1032,9 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
   (define handle-actions
     '(ignore poweroff reboot halt kexec suspend hibernate hybrid-sleep lock))
   (define (handle-action x)
-    (enum x handle-actions))
+    (if (unspecified? x)
+        ""                              ;empty serializer
+        (enum x handle-actions)))
   (define (sleep-list tokens)
     (unless (valid-list? tokens char-set:user-name)
       (error "invalid sleep list" tokens))
diff --git a/gnu/services/file-sharing.scm b/gnu/services/file-sharing.scm
index e32d1f145d..5df8b0d597 100644
--- a/gnu/services/file-sharing.scm
+++ b/gnu/services/file-sharing.scm
@@ -115,7 +115,7 @@ type generated and used by Transmission clients, suitable for passing to the
 (set! serialize-maybe-string
   (lambda (field-name val)
     (serialize-string field-name
-                      (if (unspecified? val)
+                      (if (eq? val 'unset)
                           ""
                           val))))
 
@@ -180,7 +180,7 @@ 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 (unspecified? val)
+    (if (eq? val 'unset)
         (serialize-string field-name "")
         (serialize-file-object field-name val))))
 
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 10e6523861..43f144a42d 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -30,6 +30,7 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
   #:use-module (gnu system shadow)
+  #:use-module (gnu system setuid)
   #:use-module (gnu packages mail)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages dav)
@@ -1653,7 +1654,8 @@ by @code{dovecot-configuration}.  @var{config} may also be created by
   (package     opensmtpd-configuration-package
                (default opensmtpd))
   (config-file opensmtpd-configuration-config-file
-               (default %default-opensmtpd-config-file)))
+               (default %default-opensmtpd-config-file))
+  (setgid-commands? opensmtpd-setgid-commands? (default #t)))
 
 (define %default-opensmtpd-config-file
   (plain-file "smtpd.conf" "
@@ -1714,6 +1716,43 @@ match from local for any action outbound
 (define %opensmtpd-pam-services
   (list (unix-pam-service "smtpd")))
 
+(define opensmtpd-set-gids
+  (match-lambda
+    (($ <opensmtpd-configuration> package config-file set-gids?)
+     (if set-gids?
+         (list
+          (setuid-program
+           (program (file-append package "/sbin/smtpctl"))
+           (setuid? #false)
+           (setgid? #true)
+           (group "smtpq"))
+          (setuid-program
+           (program (file-append package "/sbin/sendmail"))
+           (setuid? #false)
+           (setgid? #true)
+           (group "smtpq"))
+          (setuid-program
+           (program (file-append package "/sbin/send-mail"))
+           (setuid? #false)
+           (setgid? #true)
+           (group "smtpq"))
+          (setuid-program
+           (program (file-append package "/sbin/makemap"))
+           (setuid? #false)
+           (setgid? #true)
+           (group "smtpq"))
+          (setuid-program
+           (program (file-append package "/sbin/mailq"))
+           (setuid? #false)
+           (setgid? #true)
+           (group "smtpq"))
+          (setuid-program
+           (program (file-append package "/sbin/newaliases"))
+           (setuid? #false)
+           (setgid? #true)
+           (group "smtpq")))
+         '()))))
+
 (define opensmtpd-service-type
   (service-type
    (name 'opensmtpd)
@@ -1727,7 +1766,9 @@ match from local for any action outbound
           (service-extension profile-service-type
                              (compose list opensmtpd-configuration-package))
           (service-extension shepherd-root-service-type
-                             opensmtpd-shepherd-service)))
+                             opensmtpd-shepherd-service)
+          (service-extension setuid-program-service-type
+                             opensmtpd-set-gids)))
    (description "Run the OpenSMTPD, a lightweight @acronym{SMTP, Simple Mail
 Transfer Protocol} server.")))
 
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 651f90adb2..00a1c80a14 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -90,7 +90,7 @@
                      ((new-def ...)
                       (map (lambda (def target)
                              (if (eq? 'common (syntax->datum target))
-                                 #'*unspecified* def))
+                                 #''unset def))
                            #'(def ...) #'(target ...)))
                      ((new-doc ...)
                       (map (lambda (doc target)
@@ -200,7 +200,7 @@
 (define-maybe file-object-list)
 
 (define (raw-content? val)
-  (not (unspecified? val)))
+  (not (eq? val 'unset)))
 (define (serialize-raw-content field-name val)
   val)
 (define-maybe raw-content)
@@ -474,12 +474,12 @@ by the Prosody service.  See @url{https://prosody.im/doc/logging}."
      global)
 
     (http-max-content-size
-     (maybe-non-negative-integer *unspecified*)
+     (maybe-non-negative-integer 'unset)
      "Maximum allowed size of the HTTP body (in bytes)."
      common)
 
     (http-external-url
-     (maybe-string *unspecified*)
+     (maybe-string 'unset)
      "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 +556,7 @@ support.  To add an external component, you simply fill the hostname field.  See
      int-component)
 
     (mod-muc
-     (maybe-mod-muc-configuration *unspecified*)
+     (maybe-mod-muc-configuration 'unset)
      "Multi-user chat (MUC) is Prosody's module for allowing you to create
 hosted chatrooms/conferences for XMPP users.
 
@@ -573,7 +573,7 @@ See also @url{https://prosody.im/doc/modules/mod_muc}."
      ext-component)
 
     (raw-content
-     (maybe-raw-content *unspecified*)
+     (maybe-raw-content 'unset)
      "Raw content that will be added to the configuration file."
      common)))
 
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index b555c46040..3c6395b6ca 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -772,11 +772,11 @@ 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{*unspecified*} value.")
+setting this field to the @code{'unset} value.")
   (port
    (maybe-number 4222)
-   "The UDP port to bind to.  When set to @code{*unspecified*}, an available
-port is automatically selected.")
+   "The UDP port to bind to.  When left unspecified, an available port is
+automatically selected.")
   (proxy-server-port
    maybe-number
    "Spawn a proxy server listening on the specified port.")
@@ -997,15 +997,10 @@ HiddenServicePort ~a ~a~%"
                 ;; 'sd_notify' though), so we're stuck with that.
                 (start #~(make-forkexec-constructor
                           (list #$tor "-f" #$torrc)
-                          #:user "tor" #:group "tor"
-                          #:log-file "/var/log/tor.log"))
+                          #:user "tor" #:group "tor"))
                 (stop #~(make-kill-destructor))
                 (documentation "Run the Tor anonymous network overlay."))))))))
 
-(define %tor-log-rotation
-  (list (log-rotation
-         (files '("/var/log/tor.log")))))
-
 (define (tor-activation config)
   "Set up directories for Tor and its hidden services, if any."
   #~(begin
@@ -1051,9 +1046,7 @@ HiddenServicePort ~a ~a~%"
                        (service-extension account-service-type
                                           (const %tor-accounts))
                        (service-extension activation-service-type
-                                          tor-activation)
-                       (service-extension rottlog-service-type
-                                          (const %tor-log-rotation))))
+                                          tor-activation)))
 
                 ;; This can be extended with hidden services.
                 (compose concatenate)
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index e8bfbc88c5..7152f3b38d 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 (unspecified? accounts))))
+         (declarative-mode? (not (eq? 'unset 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 (unspecified? allowed-contacts))
+                             (when (not (eq? 'unset 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 (unspecified? moderators))
+                             (when (not (eq? 'unset moderators))
                                ;; Disable the 'AllModerators' property.
                                (set-all-moderators #f username)
                                ;; Remove all moderators.
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 41afe451c1..406752b35c 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -879,13 +879,11 @@ specified, the QEMU default path is used."))
       (provision '(qemu-guest-agent))
       (documentation "Run the QEMU guest agent.")
       (start #~(make-forkexec-constructor
-                `(,(string-append #$qemu "/bin/qemu-ga") "--daemon"
-                  "--pidfile=/var/run/qemu-ga.pid"
-                  "--statedir=/var/run"
-                  ,@(if #$device
-                        (list (string-append "--path=" #$device))
-                        '()))
-                #:pid-file "/var/run/qemu-ga.pid"
+                `(,(string-append #$qemu "/bin/qemu-ga")
+                  "--statedir" "/var/run"
+                  ,@(if (string-null? #$device)
+                        '()
+                        (list "--path" #$device)))
                 #:log-file "/var/log/qemu-ga.log"))
       (stop #~(make-kill-destructor))))))