Merge branch 'master' into core-updates

7 files changed, 236 insertions, 37 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3be2e984c3..ab3e441a7b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -14,6 +14,7 @@
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 qblade <qblade@protonmail.com>
+;;; Copyright © 2021 Hui Lu <luhuins@163.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,6 +42,7 @@
   #:use-module (gnu system shadow)                ; 'user-account', etc.
   #:use-module (gnu system uuid)
   #:use-module (gnu system file-systems)          ; 'file-system', etc.
+  #:use-module (gnu system keyboard)
   #:use-module (gnu system mapped-devices)
   #:use-module ((gnu system linux-initrd)
                 #:select (file-system-packages))
@@ -2215,23 +2217,13 @@ instance."
      (list (shepherd-service
             (requirement '(udev))
             (provision '(gpm))
-            (start #~(lambda ()
-                       ;; 'gpm' runs in the background and sets a PID file.
-                       ;; Note that it requires running as "root".
-                       (false-if-exception (delete-file "/var/run/gpm.pid"))
-                       (fork+exec-command (list #$(file-append gpm "/sbin/gpm")
-                                                #$@options))
-
-                       ;; Wait for the PID file to appear; declare failure if
-                       ;; it doesn't show up.
-                       (let loop ((i 3))
-                         (or (file-exists? "/var/run/gpm.pid")
-                             (if (zero? i)
-                                 #f
-                                 (begin
-                                   (sleep 1)
-                                   (loop (1- i))))))))
-
+            ;; 'gpm' runs in the background and sets a PID file.
+            ;; Note that it requires running as "root".
+            (start #~(make-forkexec-constructor
+                      (list #$(file-append gpm "/sbin/gpm")
+                            #$@options)
+                      #:pid-file "/var/run/gpm.pid"
+                      #:pid-file-timeout 3))
             (stop #~(lambda (_)
                       ;; Return #f if successfully stopped.
                       (not (zero? (system* #$(file-append gpm "/sbin/gpm")
@@ -2267,7 +2259,9 @@ notably to select, copy, and paste text.  The default options use the
   (font-engine             kmscon-configuration-font-engine
                            (default "pango"))
   (font-size               kmscon-configuration-font-size
-                           (default 12)))
+                           (default 12))
+  (keyboard-layout         kmscon-configuration-keyboard-layout
+                           (default #f))) ; #f | <keyboard-layout>
 
 (define kmscon-service-type
   (shepherd-service-type
@@ -2280,7 +2274,8 @@ notably to select, copy, and paste text.  The default options use the
            (auto-login (kmscon-configuration-auto-login config))
            (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config))
            (font-engine (kmscon-configuration-font-engine config))
-           (font-size (kmscon-configuration-font-size config)))
+           (font-size (kmscon-configuration-font-size config))
+           (keyboard-layout (kmscon-configuration-keyboard-layout config)))
 
        (define kmscon-command
          #~(list
@@ -2289,6 +2284,18 @@ notably to select, copy, and paste text.  The default options use the
             "--no-switchvt" ;Prevent a switch to the virtual terminal.
             "--font-engine" #$font-engine
             "--font-size" #$(number->string font-size)
+            #$@(if keyboard-layout
+                   (let* ((layout (keyboard-layout-name keyboard-layout))
+                          (variant (keyboard-layout-variant keyboard-layout))
+                          (model (keyboard-layout-model keyboard-layout))
+                          (options (keyboard-layout-options keyboard-layout)))
+                     `("--xkb-layout" ,layout
+                       ,@(if variant `("--xkb-variant" ,variant) '())
+                       ,@(if model `("--xkb-model" ,model) '())
+                       ,@(if (null? options)
+                             '()
+                             `("--xkb-options" ,(string-join options ",")))))
+                   '())
             #$@(if hardware-acceleration? '("--hwaccel") '())
             "--login" "--"
             #$login-program #$@login-arguments
diff --git a/gnu/services/certbot.scm b/gnu/services/certbot.scm
index 1c67ff63f1..1c819bef48 100644
--- a/gnu/services/certbot.scm
+++ b/gnu/services/certbot.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Jack Hill <jackhill@jackhill.us>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Raghav Gururajan <rg@raghavgururajan.name>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,6 +56,8 @@
                        (default '()))
   (challenge           certificate-configuration-challenge
                        (default #f))
+  (csr                 certificate-configuration-csr
+                       (default #f))
   (authentication-hook certificate-authentication-hook
                        (default #f))
   (cleanup-hook        certificate-cleanup-hook
@@ -94,8 +97,8 @@
              (map
               (match-lambda
                 (($ <certificate-configuration> custom-name domains challenge
-                                                authentication-hook cleanup-hook
-                                                deploy-hook)
+                                                csr authentication-hook
+                                                cleanup-hook deploy-hook)
                  (let ((name (or custom-name (car domains))))
                    (if challenge
                      (append
@@ -105,6 +108,7 @@
                             "--cert-name" name
                             "--manual-public-ip-logging-ok"
                             "-d" (string-join domains ","))
+                      (if csr `("--csr" ,csr) '())
                       (if email
                           `("--email" ,email)
                           '("--register-unsafely-without-email"))
@@ -120,6 +124,7 @@
                             "--webroot" "-w" webroot
                             "--cert-name" name
                             "-d" (string-join domains ","))
+                      (if csr `("--csr" ,csr) '())
                       (if email
                           `("--email" ,email)
                           '("--register-unsafely-without-email"))
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index f23840ee6d..fd07b6fa49 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -109,14 +109,18 @@ does not have a default value" field kind)))
   "Assemble PARTS into a raw (unhygienic) identifier."
   (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
 
-(define (define-maybe-helper serialize? syn)
+(define (define-maybe-helper serialize? prefix syn)
   (syntax-case syn ()
     ((_ stem)
      (with-syntax
          ((stem?            (id #'stem #'stem #'?))
           (maybe-stem?      (id #'stem #'maybe- #'stem #'?))
-          (serialize-stem   (id #'stem #'serialize- #'stem))
-          (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem)))
+          (serialize-stem   (if prefix
+                                (id #'stem prefix #'serialize- #'stem)
+                                (id #'stem #'serialize- #'stem)))
+          (serialize-maybe-stem (if prefix
+                                    (id #'stem prefix #'serialize-maybe- #'stem)
+                                    (id #'stem #'serialize-maybe- #'stem))))
        #`(begin
            (define (maybe-stem? val)
              (or (eq? val 'disabled) (stem? val)))
@@ -129,16 +133,18 @@ does not have a default value" field kind)))
 
 (define-syntax define-maybe
   (lambda (x)
-    (syntax-case x (no-serialization)
+    (syntax-case x (no-serialization prefix)
       ((_ stem (no-serialization))
-       (define-maybe-helper #f #'(_ stem)))
+       (define-maybe-helper #f #f #'(_ stem)))
+      ((_ stem (prefix serializer-prefix))
+       (define-maybe-helper #t #'serializer-prefix #'(_ stem)))
       ((_ stem)
-       (define-maybe-helper #t #'(_ stem))))))
+       (define-maybe-helper #t #f #'(_ stem))))))
 
 (define-syntax-rule (define-maybe/no-serialization stem)
   (define-maybe stem (no-serialization)))
 
-(define (define-configuration-helper serialize? syn)
+(define (define-configuration-helper serialize? serializer-prefix syn)
   (syntax-case syn ()
     ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
      (with-syntax (((field-getter ...)
@@ -165,7 +171,11 @@ does not have a default value" field kind)))
                                   ((serializer)
                                    serializer)
                                   (()
-                                  (id #'stem #'serialize- type)))))
+                                   (if serializer-prefix
+                                       (id #'stem
+                                           serializer-prefix
+                                           #'serialize- type)
+                                       (id #'stem #'serialize- type))))))
                          #'(field-type ...)
                          #'((custom-serializer ...) ...))))
        #`(begin
@@ -212,15 +222,21 @@ does not have a default value" field kind)))
 
 (define-syntax define-configuration
   (lambda (s)
-    (syntax-case s (no-serialization)
+    (syntax-case s (no-serialization prefix)
       ((_ stem (field (field-type def ...) doc custom-serializer ...) ...
           (no-serialization))
        (define-configuration-helper
-         #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+         #f #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+                 ...)))
+      ((_ stem  (field (field-type def ...) doc custom-serializer ...) ...
+          (prefix serializer-prefix))
+       (define-configuration-helper
+         #t #'serializer-prefix #'(_ stem (field (field-type def ...)
+                                                 doc custom-serializer ...)
                  ...)))
       ((_ stem (field (field-type def ...) doc custom-serializer ...) ...)
        (define-configuration-helper
-         #t #'(_ stem (field (field-type def ...) doc custom-serializer ...)
+         #t #f #'(_ stem (field (field-type def ...) doc custom-serializer ...)
                  ...))))))
 
 (define-syntax-rule (define-configuration/no-serialization
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 1ae58041d3..eeb1487116 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -492,7 +492,8 @@ restrict source notrap nomodify noquery\n"))
                                 "-c" #$ntpd.conf "-u" "ntpd"
                                 #$@(if allow-large-adjustment?
                                        '("-g")
-                                       '()))))
+                                       '()))
+                          #:log-file "/var/log/ntpd.log"))
                 (stop #~(make-kill-destructor)))))))))
 
 (define %ntp-accounts
@@ -960,6 +961,7 @@ HiddenServicePort ~a ~a~%"
                 (start #~(make-forkexec-constructor/container
                           (list #$(file-append tor "/bin/tor") "-f" #$torrc)
 
+                          #:log-file "/var/log/tor.log"
                           #:mappings (list (file-system-mapping
                                             (source "/var/lib/tor")
                                             (target source)
diff --git a/gnu/services/security-token.scm b/gnu/services/security-token.scm
index 0cbb591e10..52afad84a6 100644
--- a/gnu/services/security-token.scm
+++ b/gnu/services/security-token.scm
@@ -61,8 +61,10 @@
                    (let ((socket "/run/pcscd/pcscd.comm"))
                      (when (file-exists? socket)
                        (delete-file socket)))
-                   (invoke #$(file-append pcsc-lite "/sbin/pcscd"))
-                   (call-with-input-file "/run/pcscd/pcscd.pid" read)))
+                   (fork+exec-command
+                    (list #$(file-append pcsc-lite "/sbin/pcscd")
+                          "--foreground")
+                    #:log-file "/var/log/pcscd.log")))
         (stop #~(make-kill-destructor)))))))
 
 (define pcscd-activation
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 36e9feb05c..c8adcd06d0 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,6 +1,6 @@
 ;;; 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 © 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -561,7 +561,17 @@ potential infinite waits blocking libvirt."))
   (family   qemu-platform-family)                 ;string
   (magic    qemu-platform-magic)                  ;bytevector
   (mask     qemu-platform-mask)                   ;bytevector
-  (flags    qemu-platform-flags (default "F")))   ;string
+
+  ;; Default flags:
+  ;;
+  ;;   "F": fix binary.  Open the qemu-user binary (statically linked) as soon
+  ;;   as binfmt_misc interpretation is handled.
+  ;;
+  ;;   "P": preserve argv[0].  QEMU 6.0 detects whether it's started with this
+  ;;   flag and automatically does the right thing.  Without this flag,
+  ;;   argv[0] is replaced by the absolute file name of the executable, an
+  ;;   observable difference that can cause discrepancies.
+  (flags    qemu-platform-flags (default "FP")))  ;string
 
 (define-syntax bv
   (lambda (s)
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index 2bcbf76727..df84905eb3 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -4,6 +4,10 @@
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2021 Solene Rapenne <solene@perso.pw>
+;;; Copyright © 2021 Domagoj Stolfa <ds815@gmx.com>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Raghav Gururajan <rg@raghavgururajan.name>
+;;; Copyright © 2021 jgart <jgart@dismail.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +27,7 @@
 (define-module (gnu services vpn)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
+  #:use-module (gnu services dbus)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
@@ -30,6 +35,7 @@
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -44,6 +50,9 @@
             generate-openvpn-client-documentation
             generate-openvpn-server-documentation
 
+            strongswan-configuration
+            strongswan-service-type
+
             wireguard-peer
             wireguard-peer?
             wireguard-peer-name
@@ -64,6 +73,22 @@
             wireguard-service-type))
 
 ;;;
+;;; Bitmask.
+;;;
+
+(define-public bitmask-service-type
+  (service-type
+   (name 'bitmask)
+   (description "Setup the @uref{https://bitmask.net, Bitmask} VPN application.")
+   (default-value bitmask)
+   (extensions
+    (list
+     ;; Add bitmask to the system profile.
+     (service-extension profile-service-type list)
+     ;; Configure polkit policy of bitmask.
+     (service-extension polkit-service-type list)))))
+
+;;;
 ;;; OpenVPN.
 ;;;
 
@@ -530,6 +555,138 @@ is truncated and rewritten every minute.")
    'openvpn-client-configuration))
 
 ;;;
+;;; Strongswan.
+;;;
+
+(define-record-type* <strongswan-configuration>
+  strongswan-configuration make-strongswan-configuration
+  strongswan-configuration?
+  (strongswan      strongswan-configuration-strongswan ;<package>
+                   (default strongswan))
+  (ipsec-conf      strongswan-configuration-ipsec-conf ;string|#f
+                   (default #f))
+  (ipsec-secrets   strongswan-configuration-ipsec-secrets ;string|#f
+                   (default #f)))
+
+;; In the future, it might be worth implementing a record type to configure
+;; all of the plugins, but for *most* basic use cases, simply creating the
+;; files will be sufficient. Same is true of charon-plugins.
+(define strongswand-configuration-files
+  (list "charon" "charon-logging" "pki" "pool" "scepclient"
+        "swanctl" "tnc"))
+
+;; Plugins to load. All of these plugins end up as configuration files in
+;; strongswan.d/charon/.
+(define charon-plugins
+  (list "aes" "aesni" "attr" "attr-sql" "chapoly" "cmac" "constraints"
+        "counters" "curl" "curve25519" "dhcp" "dnskey" "drbg" "eap-aka-3gpp"
+        "eap-aka" "eap-dynamic" "eap-identity" "eap-md5" "eap-mschapv2"
+        "eap-peap" "eap-radius" "eap-simaka-pseudonym" "eap-simaka-reauth"
+        "eap-simaka-sql" "eap-sim" "eap-sim-file" "eap-tls" "eap-tnc"
+        "eap-ttls" "ext-auth" "farp" "fips-prf" "gmp" "ha" "hmac"
+        "kernel-netlink" "led" "md4" "md5" "mgf1" "nonce" "openssl" "pem"
+        "pgp" "pkcs12" "pkcs1" "pkcs7" "pkcs8" "pubkey" "random" "rc2"
+        "resolve" "revocation" "sha1" "sha2" "socket-default" "soup" "sql"
+        "sqlite" "sshkey" "tnc-tnccs" "vici" "x509" "xauth-eap" "xauth-generic"
+        "xauth-noauth" "xauth-pam" "xcbc"))
+
+(define (strongswan-configuration-file config)
+  (match-record config <strongswan-configuration>
+    (strongswan ipsec-conf ipsec-secrets)
+    (if (eq? (string? ipsec-conf) (string? ipsec-secrets))
+        (let* ((strongswan-dir
+                (computed-file
+                 "strongswan.d"
+                 #~(begin
+                     (mkdir #$output)
+                     ;; Create all of the configuration files strongswan.d/.
+                     (map (lambda (conf-file)
+                            (let* ((filename (string-append
+                                              #$output "/"
+                                              conf-file ".conf")))
+                              (call-with-output-file filename
+                                (lambda (port)
+                                  (display
+                                   "# Created by 'strongswan-service'\n"
+                                   port)))))
+                          (list #$@strongswand-configuration-files))
+                     (mkdir (string-append #$output "/charon"))
+                     ;; Create all of the plugin configuration files.
+                     (map (lambda (plugin)
+                            (let* ((filename (string-append
+                                              #$output "/charon/"
+                                              plugin ".conf")))
+                              (call-with-output-file filename
+                                (lambda (port)
+                                  (format port "~a {
+  load = yes
+}"
+                                          plugin)))))
+                          (list #$@charon-plugins))))))
+          ;; Generate our strongswan.conf to reflect the user configuration.
+          (computed-file
+           "strongswan.conf"
+           #~(begin
+               (call-with-output-file #$output
+                 (lambda (port)
+                   (display "# Generated by 'strongswan-service'.\n" port)
+                   (format port "charon {
+  load_modular = yes
+  plugins {
+    include ~a/charon/*.conf"
+                           #$strongswan-dir)
+                   (if #$ipsec-conf
+                       (format port "
+    stroke {
+      load = yes
+      secrets_file = ~a
+    }
+  }
+}
+
+starter {
+  config_file = ~a
+}
+
+include ~a/*.conf"
+                               #$ipsec-secrets
+                               #$ipsec-conf
+                               #$strongswan-dir)
+                       (format port "
+  }
+}
+include ~a/*.conf"
+                               #$strongswan-dir)))))))
+        (throw 'error
+               (G_ "strongSwan ipsec-conf and ipsec-secrets must both be (un)set")))))
+
+(define (strongswan-shepherd-service config)
+  (let* ((ipsec (file-append strongswan "/sbin/ipsec"))
+        (strongswan-conf-path (strongswan-configuration-file config)))
+    (list (shepherd-service
+           (requirement '(networking))
+           (provision '(ipsec))
+           (start #~(make-forkexec-constructor
+                     (list #$ipsec "start" "--nofork")
+                     #:environment-variables
+                     (list (string-append "STRONGSWAN_CONF="
+                                          #$strongswan-conf-path))))
+           (stop #~(make-kill-destructor))
+           (documentation
+            "strongSwan's charon IKE keying daemon for IPsec VPN.")))))
+
+(define strongswan-service-type
+  (service-type
+   (name 'strongswan)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             strongswan-shepherd-service)))
+   (default-value (strongswan-configuration))
+   (description
+    "Connect to an IPsec @acronym{VPN, Virtual Private Network} with
+strongSwan.")))
+
+;;;
 ;;; Wireguard.
 ;;;