summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/cups.scm2
-rw-r--r--gnu/services/desktop.scm29
-rw-r--r--gnu/services/docker.scm20
-rw-r--r--gnu/services/hurd.scm118
-rw-r--r--gnu/services/nfs.scm14
-rw-r--r--gnu/services/xorg.scm161
6 files changed, 235 insertions, 109 deletions
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index c3c6d2f1be..16d6f76c1a 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -869,7 +869,7 @@ IPP specifications.")
(use-modules (guix build utils))
(define (mkdir-p/perms directory owner perms)
(mkdir-p directory)
- (chown "/var/run/cups" (passwd:uid owner) (passwd:gid owner))
+ (chown directory (passwd:uid owner) (passwd:gid owner))
(chmod directory perms))
(define (build-subject parameters)
(string-concatenate
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 93f2ae576c..9e45743586 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1036,29 +1036,12 @@ with the administrator's password."
(match-record enlightenment-desktop-configuration
<enlightenment-desktop-configuration>
(enlightenment)
- (let ((module-arch (match (string-tokenize (%current-system)
- (char-set-complement (char-set #\-)))
- ((arch "linux") (string-append "linux-gnu-" arch))
- ((arch "gnu") (string-append "gnu-" arch)))))
- (list (file-append enlightenment
- "/lib/enlightenment/utils/enlightenment_sys")
- (file-append enlightenment
- "/lib/enlightenment/utils/enlightenment_backlight")
- ;; TODO: Move this binary to a screen-locker service.
- (file-append enlightenment
- "/lib/enlightenment/utils/enlightenment_ckpasswd")
- (file-append enlightenment
- (string-append
- "/lib/enlightenment/modules/cpufreq/"
- module-arch "-"
- (package-version enlightenment)
- "/freqset"))
- (file-append enlightenment
- (string-append
- "/lib/enlightenment/modules/sysinfo/"
- module-arch "-"
- (package-version enlightenment)
- "/cpuclock_sysfs"))))))
+ (list (file-append enlightenment
+ "/lib/enlightenment/utils/enlightenment_sys")
+ (file-append enlightenment
+ "/lib/enlightenment/utils/enlightenment_system")
+ (file-append enlightenment
+ "/lib/enlightenment/utils/enlightenment_ckpasswd"))))
(define enlightenment-desktop-service-type
(service-type
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/hurd.scm b/gnu/services/hurd.scm
new file mode 100644
index 0000000000..61d92b4bda
--- /dev/null
+++ b/gnu/services/hurd.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services hurd)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages hurd)
+ #:use-module (gnu services)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu system)
+ #:use-module (guix gexp)
+ #:use-module (guix records)
+ #:export (hurd-console-configuration
+ hurd-console-service-type
+ hurd-getty-configuration
+ hurd-getty-service-type))
+
+;;; Commentary:
+;;;
+;;; This module implements services for the Hurd.
+;;;
+;;; Code:
+
+;;;
+;;; The Hurd VGA console service.
+;;;
+
+(define-record-type* <hurd-console-configuration>
+ hurd-console-configuration make-hurd-console-configuration
+ hurd-console-configuration?
+ (hurd hurd-console-configuration-hurd ;package
+ (default hurd)))
+
+(define (hurd-console-shepherd-service config)
+ "Return a <shepherd-service> for a Hurd VGA console with CONFIG."
+
+ (define console-command
+ #~(list
+ (string-append #$(hurd-console-configuration-hurd config) "/bin/console")
+ "-c" "/dev/vcs"
+ "-d" "vga"
+ "-d" "pc_kbd"
+ "-d" "generic_speaker"))
+
+ (list (shepherd-service
+ (documentation "Run the Hurd’s VGA console client.")
+ (provision '(console))
+ (requirement '(user-processes))
+ (start #~(make-forkexec-constructor #$console-command))
+ (stop #~(make-kill-destructor)))))
+
+(define hurd-console-service-type
+ (service-type
+ (name 'console)
+ (description "Run the Hurd console client.")
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ hurd-console-shepherd-service)))
+ (default-value (hurd-console-configuration))))
+
+
+;;;
+;;; The Hurd getty service.
+;;;
+
+(define-record-type* <hurd-getty-configuration>
+ hurd-getty-configuration make-hurd-getty-configuration
+ hurd-getty-configuration?
+ (hurd hurd-getty-configuration-hurd ;<package>
+ (default hurd))
+ (tty hurd-getty-configuration-tty) ;string
+ (baud-rate hurd-getty-configuration-baud-rate
+ (default 38400))) ;integer
+
+(define (hurd-getty-shepherd-service config)
+ "Return a <shepherd-service> for a Hurd getty with CONFIG."
+
+ (let ((hurd (hurd-getty-configuration-hurd config))
+ (tty (hurd-getty-configuration-tty config))
+ (baud-rate (hurd-getty-configuration-baud-rate config)))
+
+ (define getty-command
+ #~(list
+ (string-append #$hurd "/libexec/getty")
+ #$(number->string baud-rate)
+ #$tty))
+
+ (list
+ (shepherd-service
+ (documentation "Run getty on a tty.")
+ (provision (list (string->symbol (string-append "term-" tty))))
+ (requirement '(user-processes console))
+ (start #~(make-forkexec-constructor #$getty-command))
+ (stop #~(make-kill-destructor))))))
+
+(define hurd-getty-service-type
+ (service-type
+ (name 'getty)
+ (extensions (list (service-extension shepherd-root-service-type
+ hurd-getty-shepherd-service)))
+ (description
+ "Provide console login using the Hurd @command{getty} program.")))
+
+;;; hurd.scm ends here
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
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-11 05:27:43 +0000