Merge branch 'master' into core-updates

5 files changed, 166 insertions, 65 deletions

diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 7bd43cd427..914a0d337f 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -81,70 +81,68 @@
 
 (define (cuirass-shepherd-service config)
   "Return a <shepherd-service> for the Cuirass service with CONFIG."
-  (and
-   (cuirass-configuration? config)
-   (let ((cuirass          (cuirass-configuration-cuirass config))
-         (cache-directory  (cuirass-configuration-cache-directory config))
-         (web-log-file     (cuirass-configuration-web-log-file config))
-         (log-file         (cuirass-configuration-log-file config))
-         (user             (cuirass-configuration-user config))
-         (group            (cuirass-configuration-group config))
-         (interval         (cuirass-configuration-interval config))
-         (database         (cuirass-configuration-database config))
-         (ttl              (cuirass-configuration-ttl config))
-         (port             (cuirass-configuration-port config))
-         (host             (cuirass-configuration-host config))
-         (specs            (cuirass-configuration-specifications config))
-         (use-substitutes? (cuirass-configuration-use-substitutes? config))
-         (one-shot?        (cuirass-configuration-one-shot? config))
-         (fallback?        (cuirass-configuration-fallback? config)))
-     (list (shepherd-service
-            (documentation "Run Cuirass.")
-            (provision '(cuirass))
-            (requirement '(guix-daemon networking))
-            (start #~(make-forkexec-constructor
-                      (list (string-append #$cuirass "/bin/cuirass")
-                            "--cache-directory" #$cache-directory
-                            "--specifications"
-                            #$(scheme-file "cuirass-specs.scm" specs)
-                            "--database" #$database
-                            "--ttl" #$(string-append (number->string ttl) "s")
-                            "--interval" #$(number->string interval)
-                            #$@(if use-substitutes? '("--use-substitutes") '())
-                            #$@(if one-shot? '("--one-shot") '())
-                            #$@(if fallback? '("--fallback") '()))
+  (let ((cuirass          (cuirass-configuration-cuirass config))
+        (cache-directory  (cuirass-configuration-cache-directory config))
+        (web-log-file     (cuirass-configuration-web-log-file config))
+        (log-file         (cuirass-configuration-log-file config))
+        (user             (cuirass-configuration-user config))
+        (group            (cuirass-configuration-group config))
+        (interval         (cuirass-configuration-interval config))
+        (database         (cuirass-configuration-database config))
+        (ttl              (cuirass-configuration-ttl config))
+        (port             (cuirass-configuration-port config))
+        (host             (cuirass-configuration-host config))
+        (specs            (cuirass-configuration-specifications config))
+        (use-substitutes? (cuirass-configuration-use-substitutes? config))
+        (one-shot?        (cuirass-configuration-one-shot? config))
+        (fallback?        (cuirass-configuration-fallback? config)))
+    (list (shepherd-service
+           (documentation "Run Cuirass.")
+           (provision '(cuirass))
+           (requirement '(guix-daemon networking))
+           (start #~(make-forkexec-constructor
+                     (list (string-append #$cuirass "/bin/cuirass")
+                           "--cache-directory" #$cache-directory
+                           "--specifications"
+                           #$(scheme-file "cuirass-specs.scm" specs)
+                           "--database" #$database
+                           "--ttl" #$(string-append (number->string ttl) "s")
+                           "--interval" #$(number->string interval)
+                           #$@(if use-substitutes? '("--use-substitutes") '())
+                           #$@(if one-shot? '("--one-shot") '())
+                           #$@(if fallback? '("--fallback") '()))
 
-                      #:environment-variables
-                      (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
-                            (string-append "GIT_EXEC_PATH=" #$git
-                                           "/libexec/git-core"))
+                     #:environment-variables
+                     (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
+                           (string-append "GIT_EXEC_PATH=" #$git
+                                          "/libexec/git-core"))
 
-                      #:user #$user
-                      #:group #$group
-                      #:log-file #$log-file))
-            (stop #~(make-kill-destructor)))
-           (shepherd-service
-            (documentation "Run Cuirass web interface.")
-            (provision '(cuirass-web))
-            (requirement '(guix-daemon networking))
-            (start #~(make-forkexec-constructor
-                      (list (string-append #$cuirass "/bin/cuirass")
-                            "--cache-directory" #$cache-directory
-                            "--specifications"
-                            #$(scheme-file "cuirass-specs.scm" specs)
-                            "--database" #$database
-                            "--ttl" #$(string-append (number->string ttl) "s")
-                            "--web"
-                            "--port" #$(number->string port)
-                            "--listen" #$host
-                            "--interval" #$(number->string interval)
-                            #$@(if use-substitutes? '("--use-substitutes") '())
-                            #$@(if fallback? '("--fallback") '()))
+                     #:user #$user
+                     #:group #$group
+                     #:log-file #$log-file))
+           (stop #~(make-kill-destructor)))
+          (shepherd-service
+           (documentation "Run Cuirass web interface.")
+           (provision '(cuirass-web))
+           (requirement '(guix-daemon networking))
+           (start #~(make-forkexec-constructor
+                     (list (string-append #$cuirass "/bin/cuirass")
+                           "--cache-directory" #$cache-directory
+                           "--specifications"
+                           #$(scheme-file "cuirass-specs.scm" specs)
+                           "--database" #$database
+                           "--ttl" #$(string-append (number->string ttl) "s")
+                           "--web"
+                           "--port" #$(number->string port)
+                           "--listen" #$host
+                           "--interval" #$(number->string interval)
+                           #$@(if use-substitutes? '("--use-substitutes") '())
+                           #$@(if fallback? '("--fallback") '()))
 
-                      #:user #$user
-                      #:group #$group
-                      #:log-file #$web-log-file))
-            (stop #~(make-kill-destructor)))))))
+                     #:user #$user
+                     #:group #$group
+                     #:log-file #$web-log-file))
+           (stop #~(make-kill-destructor))))))
 
 (define (cuirass-account config)
   "Return the user accounts and user groups for CONFIG."
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 3de0b4c2f3..2606aa9e3e 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -137,7 +137,7 @@
 (define (free-form-fields? val)
   (match val
     (() #t)
-    ((((? symbol?) . (? string)) . val) (free-form-fields? val))
+    ((((? symbol?) . (? string?)) . val) (free-form-fields? val))
     (_ #f)))
 (define (serialize-free-form-fields field-name val)
   (for-each (match-lambda ((k . v) (serialize-field k v))) val))
@@ -145,7 +145,7 @@
 (define (free-form-args? val)
   (match val
     (() #t)
-    ((((? symbol?) . (? string)) . val) (free-form-args? val))
+    ((((? symbol?) . (? string?)) . val) (free-form-args? val))
     (_ #f)))
 (define (serialize-free-form-args field-name val)
   (serialize-field field-name
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index c775242f99..dd63009116 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -144,7 +145,14 @@
             iptables-configuration-iptables
             iptables-configuration-ipv4-rules
             iptables-configuration-ipv6-rules
-            iptables-service-type))
+            iptables-service-type
+
+            nftables-service-type
+            nftables-configuration
+            nftables-configuration?
+            nftables-configuration-package
+            nftables-configuration-ruleset
+            %default-nftables-ruleset))
 
 ;;; Commentary:
 ;;;
@@ -1415,4 +1423,76 @@ COMMIT
     (list (service-extension shepherd-root-service-type
                              (compose list iptables-shepherd-service))))))
 
+;;;
+;;; nftables
+;;;
+
+(define %default-nftables-ruleset
+  (plain-file "nftables.conf"
+              "# A simple and safe firewall
+table inet filter {
+  chain input {
+    type filter hook input priority 0; policy drop;
+
+    # early drop of invalid connections
+    ct state invalid drop
+
+    # allow established/related connections
+    ct state { established, related } accept
+
+    # allow from loopback
+    iifname lo accept
+
+    # allow icmp
+    ip protocol icmp accept
+    ip6 nexthdr icmpv6 accept
+
+    # allow ssh
+    tcp dport ssh accept
+
+    # reject everything else
+    reject with icmpx type port-unreachable
+  }
+  chain forward {
+    type filter hook forward priority 0; policy drop;
+  }
+  chain output {
+    type filter hook output priority 0; policy accept;
+  }
+}
+"))
+
+(define-record-type* <nftables-configuration>
+  nftables-configuration
+  make-nftables-configuration
+  nftables-configuration?
+  (package nftables-configuration-package
+           (default nftables))
+  (ruleset nftables-configuration-ruleset ; file-like object
+           (default %default-nftables-ruleset)))
+
+(define nftables-shepherd-service
+  (match-lambda
+    (($ <nftables-configuration> package ruleset)
+     (let ((nft (file-append package "/sbin/nft")))
+       (shepherd-service
+        (documentation "Packet filtering and classification")
+        (provision '(nftables))
+        (start #~(lambda _
+                   (invoke #$nft "--file" #$ruleset)))
+        (stop #~(lambda _
+                  (invoke #$nft "flush" "ruleset"))))))))
+
+(define nftables-service-type
+  (service-type
+   (name 'nftables)
+   (description
+    "Run @command{nft}, setting up the specified ruleset.")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             (compose list nftables-shepherd-service))
+          (service-extension profile-service-type
+                             (compose list nftables-configuration-package))))
+   (default-value (nftables-configuration))))
+
 ;;; networking.scm ends here
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 3eecd2c085..bc8ac9b40a 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -313,7 +313,7 @@ be logged:
 Multiple filters can be defined in a single filters statement, they just
 need to be separated by spaces.")
   (log-outputs
-    (string "3:stderr")
+    (string "3:syslog:libvirtd")
     "Logging outputs.
 
 An output is one of the places to save logging information
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 06d72b5f60..1d55e388a1 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -773,6 +773,27 @@ the GNOME desktop environment.")
          (home-directory "/var/lib/gdm")
          (shell (file-append shadow "/sbin/nologin")))))
 
+(define %gdm-activation
+  ;; Ensure /var/lib/gdm is owned by the "gdm" user.  This is normally the
+  ;; case but could be wrong if the "gdm" user was created, then removed, and
+  ;; then recreated under a different UID/GID: <https://bugs.gnu.org/37423>.
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (let* ((gdm (getpwnam "gdm"))
+               (uid (passwd:uid gdm))
+               (gid (passwd:gid gdm))
+               (st  (stat "/var/lib/gdm" #f)))
+          ;; Recurse into /var/lib/gdm only if it has wrong ownership.
+          (when (and st
+                     (or (not (= uid (stat:uid st)))
+                         (not (= gid (stat:gid st)))))
+            (for-each (lambda (file)
+                        (chown file uid gid))
+                      (find-files "/var/lib/gdm"
+                                  #:directories? #t)))))))
+
 (define dbus-daemon-wrapper
   (program-file
    "gdm-dbus-wrapper"
@@ -915,6 +936,8 @@ the GNOME desktop environment.")
                 (extensions
                  (list (service-extension shepherd-root-service-type
                                           gdm-shepherd-service)
+                       (service-extension activation-service-type
+                                          (const %gdm-activation))
                        (service-extension account-service-type
                                           (const %gdm-accounts))
                        (service-extension pam-root-service-type