diff options
Diffstat (limited to 'gnu/services')
-rw-r--r-- | gnu/services/docker.scm | 20 | ||||
-rw-r--r-- | gnu/services/nfs.scm | 14 | ||||
-rw-r--r-- | gnu/services/xorg.scm | 161 |
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 |