summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2020-06-06 21:25:43 +0200
committerMarius Bakke <marius@gnu.org>2020-06-06 21:25:43 +0200
commit7ce1b5e7b74d6409d0bd0bc4272f65edc34fd9df (patch)
tree504a250d235a3bc39571e6af1c755077390a371f /gnu/services
parentf20d1cfb51ed14f325da000406807076323f70bc (diff)
parentb69ca4d234db8fe2750e9b0d6b6139a5a89a4da6 (diff)
downloadguix-7ce1b5e7b74d6409d0bd0bc4272f65edc34fd9df.tar.gz
Merge branch 'master' into staging
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/docker.scm20
-rw-r--r--gnu/services/nfs.scm14
-rw-r--r--gnu/services/xorg.scm161
3 files changed, 110 insertions, 85 deletions
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index d6dc792821..937dff7bdb 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,7 +53,10 @@
 loop-back communications.")
   (enable-proxy?
    (boolean #t)
-   "Enable or disable the user-land proxy (enabled by default)."))
+   "Enable or disable the user-land proxy (enabled by default).")
+  (debug?
+   (boolean #f)
+   "Enable or disable debug output."))
 
 (define %docker-accounts
   (list (user-group (name "docker") (system? #t))))
@@ -71,19 +75,24 @@ loop-back communications.")
         (mkdir-p #$state-dir))))
 
 (define (containerd-shepherd-service config)
-  (let* ((package (docker-configuration-containerd config)))
+  (let* ((package (docker-configuration-containerd config))
+         (debug? (docker-configuration-debug? config)))
     (shepherd-service
            (documentation "containerd daemon.")
            (provision '(containerd))
            (start #~(make-forkexec-constructor
-                     (list (string-append #$package "/bin/containerd"))
+                     (list (string-append #$package "/bin/containerd")
+                           #$@(if debug?
+                                  '("--log-level=debug")
+                                  '()))
                      #:log-file "/var/log/containerd.log"))
            (stop #~(make-kill-destructor)))))
 
 (define (docker-shepherd-service config)
   (let* ((docker (docker-configuration-docker config))
          (enable-proxy? (docker-configuration-enable-proxy? config))
-         (proxy (docker-configuration-proxy config)))
+         (proxy (docker-configuration-proxy config))
+         (debug? (docker-configuration-debug? config)))
     (shepherd-service
            (documentation "Docker daemon.")
            (provision '(dockerd))
@@ -101,6 +110,9 @@ loop-back communications.")
            (start #~(make-forkexec-constructor
                      (list (string-append #$docker "/bin/dockerd")
                            "-p" "/var/run/docker.pid"
+                           #$@(if debug?
+                                  '("--debug" "--log-level=debug")
+                                  '())
                            (if #$enable-proxy? "--userland-proxy" "")
                            "--userland-proxy-path" (string-append #$proxy
                                                                   "/bin/proxy"))
diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 4e358197e2..859097e788 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -261,6 +262,10 @@
                        (default 2049))
   (nfsd-threads        nfs-configuration-nfsd-threads
                        (default 8))
+  (nfsd-tcp?           nfs-configuration-nfsd-tcp?
+                       (default #t))
+  (nfsd-udp?           nfs-configuration-nfsd-udp?
+                       (default #f))
   (pipefs-directory    nfs-configuration-pipefs-directory
                        (default default-pipefs-directory))
   ;; List of modules to debug; any of nfsd, nfs, rpc, idmap, statd, or mountd.
@@ -272,6 +277,7 @@
   (match-record config <nfs-configuration>
     (nfs-utils nfs-versions exports
                rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
+               nfsd-tcp? nfsd-udp?
                pipefs-directory debug)
     (list (shepherd-service
            (documentation "Mount the nfsd pseudo file system.")
@@ -332,7 +338,13 @@
                                #$@(map (lambda (version)
                                          (string-append "--nfs-version=" version))
                                        nfs-versions)
-                               #$(number->string nfsd-threads))))))
+                               #$(number->string nfsd-threads)
+                               #$(if nfsd-tcp?
+                                     "--tcp"
+                                     "--no-tcp")
+                               #$(if nfsd-udp?
+                                     "--udp"
+                                     "--no-udp"))))))
            (stop
             #~(lambda _
                 (zero?
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 2505bde97b..ca39994516 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -180,31 +180,32 @@
 (define (xorg-configuration->file config)
   "Compute an Xorg configuration file corresponding to CONFIG, an
 <xorg-configuration> record."
-  (define all-modules
-    ;; 'xorg-server' provides 'fbdevhw.so' etc.
-    (append (xorg-configuration-modules config)
-            (list xorg-server)))
-
-  (define build
-    #~(begin
-        (use-modules (ice-9 match)
-                     (srfi srfi-1)
-                     (srfi srfi-26))
-
-        (call-with-output-file #$output
-          (lambda (port)
-            (define drivers
-              '#$(xorg-configuration-drivers config))
+  (let ((xorg-server (xorg-configuration-server config)))
+    (define all-modules
+      ;; 'xorg-server' provides 'fbdevhw.so' etc.
+      (append (xorg-configuration-modules config)
+              (list xorg-server)))
+
+    (define build
+      #~(begin
+          (use-modules (ice-9 match)
+                       (srfi srfi-1)
+                       (srfi srfi-26))
+
+          (call-with-output-file #$output
+            (lambda (port)
+              (define drivers
+                '#$(xorg-configuration-drivers config))
 
-            (define (device-section driver)
-              (string-append "
+              (define (device-section driver)
+                (string-append "
 Section \"Device\"
   Identifier \"device-" driver "\"
   Driver \"" driver "\"
 EndSection"))
 
-            (define (screen-section driver resolutions)
-              (string-append "
+              (define (screen-section driver resolutions)
+                (string-append "
 Section \"Screen\"
   Identifier \"screen-" driver "\"
   Device \"device-" driver "\"
@@ -218,8 +219,8 @@ Section \"Screen\"
   EndSubSection
 EndSection"))
 
-            (define (input-class-section layout variant model options)
-              (string-append "
+              (define (input-class-section layout variant model options)
+                (string-append "
 Section \"InputClass\"
   Identifier \"evdev keyboard catchall\"
   MatchIsKeyboard \"on\"
@@ -243,69 +244,69 @@ Section \"InputClass\"
   Driver \"evdev\"
 EndSection\n"))
 
-            (define (expand modules)
-              ;; Append to MODULES the relevant /lib/xorg/modules
-              ;; sub-directories.
-              (append-map (lambda (module)
-                            (filter-map (lambda (directory)
-                                          (let ((full (string-append module
-                                                                     directory)))
-                                            (and (file-exists? full)
-                                                 full)))
-                                        '("/lib/xorg/modules/drivers"
-                                          "/lib/xorg/modules/input"
-                                          "/lib/xorg/modules/multimedia"
-                                          "/lib/xorg/modules/extensions")))
-                          modules))
-
-            (display "Section \"Files\"\n" port)
-            (for-each (lambda (font)
-                        (format port "  FontPath \"~a\"~%" font))
-                      '#$(xorg-configuration-fonts config))
-            (for-each (lambda (module)
-                        (format port
-                                "  ModulePath \"~a\"~%"
-                                module))
-                      (append (expand '#$all-modules)
-
-                              ;; For fbdevhw.so and so on.
-                              (list #$(file-append xorg-server
-                                                   "/lib/xorg/modules"))))
-            (display "EndSection\n" port)
-            (display "
+              (define (expand modules)
+                ;; Append to MODULES the relevant /lib/xorg/modules
+                ;; sub-directories.
+                (append-map (lambda (module)
+                              (filter-map (lambda (directory)
+                                            (let ((full (string-append module
+                                                                       directory)))
+                                              (and (file-exists? full)
+                                                   full)))
+                                          '("/lib/xorg/modules/drivers"
+                                            "/lib/xorg/modules/input"
+                                            "/lib/xorg/modules/multimedia"
+                                            "/lib/xorg/modules/extensions")))
+                            modules))
+
+              (display "Section \"Files\"\n" port)
+              (for-each (lambda (font)
+                          (format port "  FontPath \"~a\"~%" font))
+                        '#$(xorg-configuration-fonts config))
+              (for-each (lambda (module)
+                          (format port
+                                  "  ModulePath \"~a\"~%"
+                                  module))
+                        (append (expand '#$all-modules)
+
+                                ;; For fbdevhw.so and so on.
+                                (list #$(file-append xorg-server
+                                                     "/lib/xorg/modules"))))
+              (display "EndSection\n" port)
+              (display "
 Section \"ServerFlags\"
   Option \"AllowMouseOpenFail\" \"on\"
 EndSection\n" port)
 
-            (display (string-join (map device-section drivers) "\n")
-                     port)
-            (newline port)
-            (display (string-join
-                      (map (cut screen-section <>
-                                '#$(xorg-configuration-resolutions config))
-                           drivers)
-                      "\n")
-                     port)
-            (newline port)
-
-            (let ((layout  #$(and=> (xorg-configuration-keyboard-layout config)
-                                    keyboard-layout-name))
-                  (variant #$(and=> (xorg-configuration-keyboard-layout config)
-                                    keyboard-layout-variant))
-                  (model   #$(and=> (xorg-configuration-keyboard-layout config)
-                                    keyboard-layout-model))
-                  (options '#$(and=> (xorg-configuration-keyboard-layout config)
-                                     keyboard-layout-options)))
-              (when layout
-                (display (input-class-section layout variant model options)
-                         port)
-                (newline port)))
-
-            (for-each (lambda (config)
-                        (display config port))
-                      '#$(xorg-configuration-extra-config config))))))
-
-  (computed-file "xserver.conf" build))
+              (display (string-join (map device-section drivers) "\n")
+                       port)
+              (newline port)
+              (display (string-join
+                        (map (cut screen-section <>
+                                  '#$(xorg-configuration-resolutions config))
+                             drivers)
+                        "\n")
+                       port)
+              (newline port)
+
+              (let ((layout  #$(and=> (xorg-configuration-keyboard-layout config)
+                                      keyboard-layout-name))
+                    (variant #$(and=> (xorg-configuration-keyboard-layout config)
+                                      keyboard-layout-variant))
+                    (model   #$(and=> (xorg-configuration-keyboard-layout config)
+                                      keyboard-layout-model))
+                    (options '#$(and=> (xorg-configuration-keyboard-layout config)
+                                       keyboard-layout-options)))
+                (when layout
+                  (display (input-class-section layout variant model options)
+                           port)
+                  (newline port)))
+
+              (for-each (lambda (config)
+                          (display config port))
+                        '#$(xorg-configuration-extra-config config))))))
+
+    (computed-file "xserver.conf" build)))
 
 (define (xorg-configuration-directory modules)
   "Return a directory that contains the @code{.conf} files for X.org that