aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/admin.scm31
-rw-r--r--gnu/services/authentication.scm2
-rw-r--r--gnu/services/base.scm65
-rw-r--r--gnu/services/databases.scm37
-rw-r--r--gnu/services/desktop.scm57
-rw-r--r--gnu/services/dict.scm84
-rw-r--r--gnu/services/dns.scm168
-rw-r--r--gnu/services/guix.scm2
-rw-r--r--gnu/services/kerberos.scm4
-rw-r--r--gnu/services/linux.scm203
-rw-r--r--gnu/services/mcron.scm85
-rw-r--r--gnu/services/pam-mount.scm2
-rw-r--r--gnu/services/sddm.scm11
-rw-r--r--gnu/services/syncthing.scm56
14 files changed, 461 insertions, 346 deletions
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index edd8ce59da..5cf74c6e4d 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -22,7 +22,7 @@
(define-module (gnu services admin)
#:use-module (gnu packages admin)
#:use-module ((gnu packages base)
- #:select (canonical-package findutils))
+ #:select (canonical-package findutils coreutils sed))
#:use-module (gnu packages certs)
#:use-module (gnu packages package-management)
#:use-module (gnu services)
@@ -290,7 +290,7 @@ Old log files are removed or compressed according to the configuration.")
"10 23 * * 0")
(define %default-file-database-excluded-directories
- ;; Directories excluded from the 'locate' database.
+ ;; Regexps of directories excluded from the 'locate' database.
(list (%store-prefix)
"/tmp" "/var/tmp" "/var/cache" ".*/\\.cache"
"/run/udev"))
@@ -319,10 +319,10 @@ is taken.")
@command{updatedb} job (@pxref{Guile Syntax,,, mcron, GNU@tie{}mcron}).")
(excluded-directories
(string-list %default-file-database-excluded-directories)
- "List of directories to ignore when building the file database. By
-default, this includes @file{/tmp} and @file{/gnu/store}, which should instead
-be indexed by @command{guix locate} (@pxref{Invoking guix locate}). This list
-is passed to the @option{--prunepaths} option of
+ "List of regular expressions of directories to ignore when building the
+file database. By default, this includes @file{/tmp} and @file{/gnu/store};
+the latter should instead be indexed by @command{guix locate} (@pxref{Invoking
+guix locate}). This list is passed to the @option{--prunepaths} option of
@command{updatedb} (@pxref{Invoking updatedb,,, find, GNU@tie{}Findutils})."))
(define (file-database-mcron-jobs configuration)
@@ -330,11 +330,20 @@ is passed to the @option{--prunepaths} option of
(package schedule excluded-directories)
(let ((updatedb (program-file
"updatedb"
- #~(execl #$(file-append package "/bin/updatedb")
- "updatedb"
- #$(string-append "--prunepaths="
- (string-join
- excluded-directories))))))
+ #~(begin
+ ;; 'updatedb' is a shell script that expects various
+ ;; commands in $PATH.
+ (setenv "PATH"
+ (string-append #$package "/bin:"
+ #$(canonical-package coreutils)
+ "/bin:"
+ #$(canonical-package sed)
+ "/bin"))
+ (execl #$(file-append package "/bin/updatedb")
+ "updatedb"
+ #$(string-append "--prunepaths="
+ (string-join
+ excluded-directories)))))))
(list #~(job #$schedule #$updatedb)))))
(define file-database-service-type
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index f1ad1b1afe..fbfef2d3d0 100644
--- a/gnu/services/authentication.scm
+++ b/gnu/services/authentication.scm
@@ -504,7 +504,7 @@ password.")
(define (pam-ldap-pam-service config)
"Return a PAM service for LDAP authentication."
(define pam-ldap-module
- #~(string-append #$(nslcd-configuration-nss-pam-ldapd config)
+ (file-append (nslcd-configuration-nss-pam-ldapd config)
"/lib/security/pam_ldap.so"))
(pam-extension
(transformer
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 492cf8a693..b3f2d2e8b8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1603,38 +1603,36 @@ information on the configuration file syntax."
(define pam-limits-service-type
(let ((pam-extension
- (pam-extension
- (transformer
- (lambda (pam)
- (let ((pam-limits (pam-entry
- (control "required")
- (module "pam_limits.so")
- (arguments
- '("conf=/etc/security/limits.conf")))))
- (if (member (pam-service-name pam)
- '("login" "greetd" "su" "slim" "gdm-password"
- "sddm" "sudo" "sshd" "lightdm"))
- (pam-service
- (inherit pam)
- (session (cons pam-limits
- (pam-service-session pam))))
- pam))))))
-
- ;; XXX: Using file-like objects is deprecated, use lists instead.
- ;; This is to be reduced into the list? case when the deprecated
- ;; code gets removed.
- ;; Create /etc/security containing the provided "limits.conf" file.
- (security-limits
+ (lambda (limits-file)
+ (pam-extension
+ (transformer
+ (lambda (pam)
+ (let ((pam-limits (pam-entry
+ (control "required")
+ (module "pam_limits.so")
+ (arguments
+ (list #~(string-append "conf=" #$limits-file))))))
+ (if (member (pam-service-name pam)
+ '("login" "greetd" "su" "slim" "gdm-password"
+ "sddm" "lightdm" "sudo" "sshd"))
+ (pam-service
+ (inherit pam)
+ (session (cons pam-limits
+ (pam-service-session pam))))
+ pam)))))))
+ (make-limits-file
(match-lambda
+ ;; XXX: Using file-like objects is deprecated, use lists instead.
+ ;; This is to be reduced into the list? case when the deprecated
+ ;; code gets removed.
((? file-like? obj)
(warning (G_ "Using file-like value for \
'pam-limits-service-type' is deprecated~%"))
- `(("security/limits.conf" ,obj)))
+ obj)
((? list? lst)
- `(("security/limits.conf"
- ,(plain-file "limits.conf"
- (string-join (map pam-limits-entry->string lst)
- "\n" 'suffix)))))
+ (plain-file "limits.conf"
+ (string-join (map pam-limits-entry->string lst)
+ "\n" 'suffix)))
(_ (raise
(formatted-message
(G_ "invalid input for 'pam-limits-service-type'~%")))))))
@@ -1642,13 +1640,12 @@ information on the configuration file syntax."
(service-type
(name 'limits)
(extensions
- (list (service-extension etc-service-type security-limits)
- (service-extension pam-root-service-type
- (lambda _ (list pam-extension)))))
+ (list (service-extension pam-root-service-type
+ (lambda (config)
+ (list (pam-extension (make-limits-file config)))))))
(description
- "Install the specified resource usage limits by populating
-@file{/etc/security/limits.conf} and using the @code{pam_limits}
-authentication module.")
+ "Use the @code{pam_limits} authentication module to set the specified
+resource usage limits.")
(default-value '()))))
(define-deprecated (pam-limits-service #:optional (limits '()))
@@ -3266,7 +3263,7 @@ to handle."
(define optional-pam-mount
(pam-entry
(control "optional")
- (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so"))
+ (module (file-append greetd-pam-mount "/lib/security/pam_mount.so"))
(arguments '("disable_interactive"))))
(list
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 7148971c1d..d3fee2a8ef 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -180,17 +180,30 @@ host all all ::1/128 md5"))
(data-directory postgresql-configuration-data-directory
(default "/var/lib/postgresql/data"))
(extension-packages postgresql-configuration-extension-packages
- (default '())))
-
-(define %postgresql-accounts
- (list (user-group (name "postgres") (system? #t))
- (user-account
- (name "postgres")
- (group "postgres")
- (system? #t)
- (comment "PostgreSQL server user")
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
+ (default '()))
+ (create-account? postgresql-configuration-create-account?
+ (default #t))
+ (uid postgresql-configuration-uid
+ (default #f))
+ (gid postgresql-configuration-gid
+ (default #f)))
+
+(define (create-postgresql-account config)
+ (match-record config <postgresql-configuration>
+ (create-account? uid gid)
+ (if (not create-account?) '()
+ (list (user-group
+ (name "postgres")
+ (id gid)
+ (system? #t))
+ (user-account
+ (name "postgres")
+ (group "postgres")
+ (system? #t)
+ (uid uid)
+ (comment "PostgreSQL server user")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))))
(define (final-postgresql postgresql extension-packages)
(if (null? extension-packages)
@@ -327,7 +340,7 @@ host all all ::1/128 md5"))
(service-extension activation-service-type
postgresql-activation)
(service-extension account-service-type
- (const %postgresql-accounts))
+ create-postgresql-account)
(service-extension
profile-service-type
(compose list postgresql-configuration-postgresql))))
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 01aec64bee..5b79fbcda1 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2017, 2020, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017 Nikita <nikita@n0.is>
+;;; Copyright © 2017, 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2018, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2023 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
@@ -15,6 +16,7 @@
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021, 2022 muradm <mail@muradm.net>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Zheng Junjie <873216071@qq.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -55,6 +57,9 @@
#:use-module (gnu packages cups)
#:use-module (gnu packages freedesktop)
#:use-module (gnu packages gnome)
+ #:use-module (gnu packages kde)
+ #:use-module (gnu packages kde-frameworks)
+ #:use-module (gnu packages kde-plasma)
#:use-module (gnu packages xfce)
#:use-module (gnu packages avahi)
#:use-module (gnu packages xdisorg)
@@ -150,6 +155,10 @@
sugar-desktop-configuration?
sugar-desktop-service-type
+ plasma-desktop-configuration
+ plasma-desktop-configuration?
+ plasma-desktop-service-type
+
xfce-desktop-configuration
xfce-desktop-configuration?
xfce-desktop-service
@@ -1165,6 +1174,10 @@ started~%")
(string-append #$output service-directory))
(symlink (string-append #$elogind "/etc") ;for etc/dbus-1
(string-append #$output "/etc"))
+ ;; Also expose the D-Bus policy configurations (.conf) files, now
+ ;; installed under '/share' instead of the legacy '/etc' prefix.
+ (symlink (string-append #$elogind "/share/dbus-1/system.d")
+ (string-append #$output "/share/dbus-1/system.d"))
;; Replace the "Exec=" line of the 'org.freedesktop.login1.service'
;; file with one that refers to WRAPPER instead of elogind.
@@ -1625,6 +1638,50 @@ profile, and extends dbus with the ability for @code{efl} to generate
thumbnails and makes setuid the programs which enlightenment needs to function
as expected.")))
+;;;
+;;; KDE Plasma desktop service.
+;;;
+
+(define-record-type* <plasma-desktop-configuration> plasma-desktop-configuration
+ make-plasma-desktop-configuration
+ plasma-desktop-configuration?
+ (plasma-package plasma-package (default plasma)))
+
+(define (plasma-polkit-settings config)
+ "Return the list of KDE Plasma dependencies that provide polkit actions and
+rules."
+ (let ((plasma-plasma (plasma-package config)))
+ (map (lambda (name)
+ ((package-direct-input-selector name) plasma-plasma))
+ '("plasma-desktop"
+ "plasma-workspace"
+ "plasma-disks"
+ "kinfocenter"
+ "libksysguard"
+ "ktexteditor"
+ "powerdevil"
+ "plasma-firewall"))))
+
+;; see https://bugs.kde.org/show_bug.cgi?id=456210
+;; if `kde' no exits, fallback to `other', and then unlock lockscreen not work,
+;; so add it.
+(define (plasma-pam-services config)
+ (list (unix-pam-service "kde")))
+
+(define plasma-desktop-service-type
+ (service-type
+ (name 'plasma-desktop)
+ (description "Run the KDE Plasma desktop environment.")
+ (default-value (plasma-desktop-configuration))
+ (extensions
+ (list (service-extension polkit-service-type
+ plasma-polkit-settings)
+ (service-extension pam-root-service-type
+ plasma-pam-services)
+ (service-extension profile-service-type
+ (compose list
+ plasma-package))))))
+
;;;
;;; inputattach-service-type
diff --git a/gnu/services/dict.scm b/gnu/services/dict.scm
index 23e1d36364..a4e25f5302 100644
--- a/gnu/services/dict.scm
+++ b/gnu/services/dict.scm
@@ -56,7 +56,9 @@
(handlers dicod-configuration-handlers ;list of <dicod-handler>
(default '()))
(databases dicod-configuration-databases ;list of <dicod-database>
- (default (list %dicod-database:gcide))))
+ (default (list %dicod-database:gcide)))
+ (home-service? dicod-configuration-home-service? ;boolean
+ (default for-home?) (innate)))
(define-record-type* <dicod-handler>
dicod-handler make-dicod-handler
@@ -73,12 +75,24 @@
(complex? dicod-database-complex? (default #f))
(options dicod-database-options (default '())))
+(define %dicod-gcide-index
+ ;; The GCIDE pre-built index. The Dico 'gcide' module can build it lazily;
+ ;; do it upfront so there's no need for a writable directory at run-time.
+ (computed-file "dicod-gcide-index"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (mkdir #$output)
+ (invoke #+(file-append dico "/libexec/idxgcide")
+ #+(file-append gcide "/share/gcide")
+ #$output)))))
+
(define %dicod-database:gcide
(dicod-database
(name "gcide")
(handler "gcide")
(options (list #~(string-append "dbdir=" #$gcide "/share/gcide")
- "idxdir=/var/run/dicod"))))
+ #~(string-append "idxdir=" #$%dicod-gcide-index)))))
(define %dicod-accounts
(list (user-group
@@ -137,55 +151,43 @@ database {
(apply mixed-text-file "dicod.conf" (configuration->text config)))
-(define %dicod-activation
- #~(begin
- (use-modules (guix build utils))
- (let ((user (getpwnam "dicod"))
- (rundir "/var/run/dicod"))
- (mkdir-p rundir)
- (chown rundir (passwd:uid user) (passwd:gid user)))))
-
(define (dicod-shepherd-service config)
(let* ((dicod.conf (dicod-configuration-file config))
(interfaces (dicod-configuration-interfaces config))
+ (home-service? (dicod-configuration-home-service? config))
+ (mappings `(,@(if home-service?
+ '()
+ (list (file-system-mapping
+ (source "/dev/log")
+ (target source))))
+ ,(file-system-mapping
+ (source dicod.conf)
+ (target source))))
(dicod (least-authority-wrapper
(file-append (dicod-configuration-dico config)
"/bin/dicod")
#:name "dicod"
- #:mappings (list (file-system-mapping
- (source "/var/run/dicod")
- (target source)
- (writable? #t))
- (file-system-mapping
- (source "/dev/log")
- (target source))
- (file-system-mapping
- (source dicod.conf)
- (target source)))
+ #:mappings mappings
#:namespaces (delq 'net %namespaces))))
(list (shepherd-service
(provision '(dicod))
- (requirement '(user-processes))
+ (requirement (if home-service?
+ '()
+ '(user-processes)))
(documentation "Run the dicod daemon.")
- (start #~(if (defined? 'make-inetd-constructor)
- (make-inetd-constructor
- (list #$dicod "--inetd" "--foreground"
- (string-append "--config=" #$dicod.conf))
- (map (lambda (interface)
- (endpoint
- (addrinfo:addr
- (car (getaddrinfo interface "dict")))))
- '#$interfaces)
- #:requirements '#$requirement
- #:user "dicod" #:group "dicod"
- #:service-name-stem "dicod")
- (make-forkexec-constructor
- (list #$dicod "--foreground"
- (string-append "--config=" #$dicod.conf))
- #:user "dicod" #:group "dicod")))
- (stop #~(if (defined? 'make-inetd-destructor)
- (make-inetd-destructor)
- (make-kill-destructor)))
+ (start #~(make-inetd-constructor
+ (list #$dicod "--inetd" "--foreground"
+ (string-append "--config=" #$dicod.conf))
+ (map (lambda (interface)
+ (endpoint
+ (addrinfo:addr
+ (car (getaddrinfo interface "dict")))))
+ '#$interfaces)
+ #:requirements '#$requirement
+ #:user #$(and (not home-service?) "dicod")
+ #:group #$(and (not home-service?) "dicod")
+ #:service-name-stem "dicod"))
+ (stop #~(make-inetd-destructor))
(actions (list (shepherd-configuration-action dicod.conf)))))))
(define dicod-service-type
@@ -194,8 +196,6 @@ database {
(extensions
(list (service-extension account-service-type
(const %dicod-accounts))
- (service-extension activation-service-type
- (const %dicod-activation))
(service-extension shepherd-root-service-type
dicod-shepherd-service)))
(default-value (dicod-configuration))
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index f45fc99c69..6608046909 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
-;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 Remco van 't Veer <remco@remworks.net>
@@ -53,10 +52,7 @@
knot-resolver-configuration
dnsmasq-service-type
- dnsmasq-configuration
-
- ddclient-service-type
- ddclient-configuration))
+ dnsmasq-configuration))
;;;
;;; Knot DNS.
@@ -901,165 +897,3 @@ cache.size = 100 * MB
dnsmasq-activation)))
(default-value (dnsmasq-configuration))
(description "Run the dnsmasq DNS server.")))
-
-
-;;;
-;;; ddclient
-;;;
-
-(define (uglify-field-name field-name)
- (string-delete #\? (symbol->string field-name)))
-
-(define (serialize-field field-name val)
- (when (not (member field-name '(group secret-file user)))
- (format #t "~a=~a\n" (uglify-field-name field-name) val)))
-
-(define (serialize-boolean field-name val)
- (serialize-field field-name (if val "yes" "no")))
-
-(define (serialize-integer field-name val)
- (serialize-field field-name (number->string val)))
-
-(define (serialize-string field-name val)
- (if (and (string? val) (string=? val ""))
- ""
- (serialize-field field-name val)))
-
-(define (serialize-list field-name val)
- (if (null? val) "" (serialize-field field-name (string-join val))))
-
-(define (serialize-extra-options extra-options)
- (string-join extra-options "\n" 'suffix))
-
-(define-configuration ddclient-configuration
- (ddclient
- (file-like ddclient)
- "The ddclient package.")
- (daemon
- (integer 300)
- "The period after which ddclient will retry to check IP and domain name.")
- (syslog
- (boolean #t)
- "Use syslog for the output.")
- (mail
- (string "root")
- "Mail to user.")
- (mail-failure
- (string "root")
- "Mail failed update to user.")
- (pid
- (string "/var/run/ddclient/ddclient.pid")
- "The ddclient PID file.")
- (ssl
- (boolean #t)
- "Enable SSL support.")
- (user
- (string "ddclient")
- "Specifies the user name or ID that is used when running ddclient
-program.")
- (group
- (string "ddclient")
- "Group of the user who will run the ddclient program.")
- (secret-file
- (string "/etc/ddclient/secrets.conf")
- "Secret file which will be appended to @file{ddclient.conf} file. This
-file contains credentials for use by ddclient. You are expected to create it
-manually.")
- (extra-options
- (list '())
- "Extra options will be appended to @file{ddclient.conf} file."))
-
-(define (ddclient-account config)
- "Return the user accounts and user groups for CONFIG."
- (let ((ddclient-user (ddclient-configuration-user config))
- (ddclient-group (ddclient-configuration-group config)))
- (list (user-group
- (name ddclient-group)
- (system? #t))
- (user-account
- (name ddclient-user)
- (system? #t)
- (group ddclient-group)
- (comment "ddclientd privilege separation user")
- (home-directory (string-append "/var/run/" ddclient-user))))))
-
-(define (ddclient-activation config)
- "Return the activation GEXP for CONFIG."
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 rdelim))
- (let ((ddclient-user
- (passwd:uid (getpw #$(ddclient-configuration-user config))))
- (ddclient-group
- (passwd:gid (getpw #$(ddclient-configuration-group config))))
- (ddclient-secret-file
- #$(ddclient-configuration-secret-file config)))
- ;; 'ddclient' complains about ddclient.conf file permissions, which
- ;; rules out /gnu/store. Thus we copy the ddclient.conf to /etc.
- (for-each (lambda (dir)
- (mkdir-p dir)
- (chmod dir #o700)
- (chown dir ddclient-user ddclient-group))
- '("/var/cache/ddclient" "/var/run/ddclient"
- "/etc/ddclient"))
- (with-output-to-file "/etc/ddclient/ddclient.conf"
- (lambda ()
- (display
- (string-append
- "# Generated by 'ddclient-service'.\n\n"
- #$(with-output-to-string
- (lambda ()
- (serialize-configuration config
- ddclient-configuration-fields)))
- (if (string-null? ddclient-secret-file)
- ""
- (format #f "\n\n# Appended from '~a'.\n\n~a"
- ddclient-secret-file
- (with-input-from-file ddclient-secret-file
- read-string)))))))
- (chmod "/etc/ddclient/ddclient.conf" #o600)
- (chown "/etc/ddclient/ddclient.conf"
- ddclient-user ddclient-group)))))
-
-(define (ddclient-shepherd-service config)
- "Return a <shepherd-service> for ddclient with CONFIG."
- (let ((ddclient (ddclient-configuration-ddclient config))
- (ddclient-pid (ddclient-configuration-pid config))
- (ddclient-user (ddclient-configuration-user config))
- (ddclient-group (ddclient-configuration-group config)))
- (list (shepherd-service
- (provision '(ddclient))
- (documentation "Run ddclient daemon.")
- (start #~(make-forkexec-constructor
- (list #$(file-append ddclient "/bin/ddclient")
- "-foreground"
- "-file" "/etc/ddclient/ddclient.conf")
- #:pid-file #$ddclient-pid
- #:environment-variables
- (list "SSL_CERT_DIR=/run/current-system/profile\
-/etc/ssl/certs"
- "SSL_CERT_FILE=/run/current-system/profile\
-/etc/ssl/certs/ca-certificates.crt")
- #:user #$ddclient-user
- #:group #$ddclient-group))
- (stop #~(make-kill-destructor))))))
-
-(define ddclient-service-type
- (service-type
- (name 'ddclient)
- (extensions
- (list (service-extension account-service-type
- ddclient-account)
- (service-extension shepherd-root-service-type
- ddclient-shepherd-service)
- (service-extension activation-service-type
- ddclient-activation)))
- (default-value (ddclient-configuration))
- (description "Configure address updating utility for dynamic DNS services,
-ddclient.")))
-
-(define (generate-ddclient-documentation)
- (generate-documentation
- `((ddclient-configuration ,ddclient-configuration-fields))
- 'ddclient-configuration))
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 1450eedf37..81bfe45e4e 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -440,7 +440,7 @@
(shepherd-service
(documentation "Guix Build Coordinator Agent")
(provision '(guix-build-coordinator-agent))
- (requirement '(networking))
+ (requirement '(networking user-processes))
(start
#~(lambda _
(parameterize ((%current-logfile-date-format ""))
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index 1a1b37f890..a6f540a9b6 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -432,8 +432,8 @@ generates such a file. It does not cause any daemon to be started.")))
(transformer
(lambda (pam)
(define pam-krb5-module
- #~(string-append #$(pam-krb5-configuration-pam-krb5 config)
- "/lib/security/pam_krb5.so"))
+ (file-append (pam-krb5-configuration-pam-krb5 config)
+ "/lib/security/pam_krb5.so"))
(let ((pam-krb5-sufficient
(pam-entry
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index d105c42850..1f01b39a21 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner@lease-up.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -67,6 +68,28 @@
kernel-module-loader-service-type
+ cachefilesd-configuration
+ cachefilesd-configuration?
+ cachefilesd-configuration-cachefilesd
+ cachefilesd-configuration-debug-output?
+ cachefilesd-configuration-use-syslog?
+ cachefilesd-configuration-scan?
+ cachefilesd-configuration-cache-directory
+ cachefilesd-configuration-cache-name
+ cachefilesd-configuration-security-context
+ cachefilesd-configuration-pause-culling-for-block-percentage
+ cachefilesd-configuration-pause-culling-for-file-percentage
+ cachefilesd-configuration-resume-culling-for-block-percentage
+ cachefilesd-configuration-resume-culling-for-file-percentage
+ cachefilesd-configuration-pause-caching-for-block-percentage
+ cachefilesd-configuration-pause-caching-for-file-percentage
+ cachefilesd-configuration-log2-table-size
+ cachefilesd-configuration-cull?
+ cachefilesd-configuration-trace-function-entry-in-kernel-module
+ cachefilesd-configuration-trace-function-exit-in-kernel-module
+ cachefilesd-configuration-trace-internal-checkpoints-in-kernel-module
+ cachefilesd-service-type
+
rasdaemon-configuration
rasdaemon-configuration?
rasdaemon-configuration-record?
@@ -151,6 +174,7 @@ representation."
(shepherd-service
(documentation "Run the Early OOM daemon.")
(provision '(earlyoom))
+ (requirement '(user-processes))
(start #~(make-forkexec-constructor
'#$(earlyoom-configuration->command-line-args config)
#:log-file "/var/log/earlyoom.log"))
@@ -169,7 +193,8 @@ representation."
(compose list earlyoom-shepherd-service))
(service-extension rottlog-service-type
(const %earlyoom-log-rotation))))
- (description "Run @command{earlyoom}, the Early OOM daemon.")))
+ (description "Run @command{earlyoom}, a daemon that quickly responds to
+@acronym{OOM, out-of-memory} conditions by terminating relevant processes.")))
;;;
@@ -308,6 +333,180 @@ more information)."
;;;
+;;; Cachefilesd, an FS-Cache daemon
+;;;
+
+(define (serialize-string variable-symbol value)
+ #~(format #f "~a ~a~%" #$(symbol->string variable-symbol) #$value))
+
+(define-maybe string)
+
+(define (non-negative-integer? val)
+ (and (exact-integer? val) (not (negative? val))))
+
+(define (serialize-non-negative-integer variable-symbol value)
+ #~(format #f "~a ~d~%" #$(symbol->string variable-symbol) #$value))
+
+(define-maybe non-negative-integer)
+
+(define (make-option-serializer option-symbol)
+ (lambda (variable-symbol text)
+ (if (maybe-value-set? text)
+ #~(format #f "~a ~a~%" #$(symbol->string option-symbol) #$text)
+ "")))
+
+(define (make-percentage-threshold-serializer threshold-symbol)
+ (lambda (variable-symbol percentage)
+ (if (maybe-value-set? percentage)
+ #~(format #f "~a ~a%~%" #$(symbol->string threshold-symbol) #$percentage)
+ "")))
+
+(define-configuration cachefilesd-configuration
+ (cachefilesd
+ (file-like cachefilesd)
+ "The cachefilesd package to use."
+ (serializer empty-serializer))
+
+ ;; command-line options
+ (debug-output?
+ (boolean #f)
+ "Print debugging output to stderr."
+ (serializer empty-serializer))
+
+ (use-syslog?
+ (boolean #t)
+ "Log to syslog facility instead of stdout."
+ (serializer empty-serializer))
+
+ ;; culling is part of the configuration file
+ ;; despite the name of the command-line option
+ (scan?
+ (boolean #t)
+ "Scan for cachable objects."
+ (serializer empty-serializer))
+
+ ;; sole required field in the configuration file
+ (cache-directory
+ maybe-string
+ "Location of the cache directory."
+ (serializer (make-option-serializer 'dir)))
+
+ (cache-name
+ (maybe-string "CacheFiles")
+ "Name of cache (keep unique)."
+ (serializer (make-option-serializer 'tag)))
+
+ (security-context
+ maybe-string
+ "SELinux security context."
+ (serializer (make-option-serializer 'secctx)))
+
+ ;; percentage thresholds in the configuration file
+ (pause-culling-for-block-percentage
+ (maybe-non-negative-integer 7)
+ "Pause culling when available blocks exceed this percentage."
+ (serializer (make-percentage-threshold-serializer 'brun)))
+
+ (pause-culling-for-file-percentage
+ (maybe-non-negative-integer 7)
+ "Pause culling when available files exceed this percentage."
+ (serializer (make-percentage-threshold-serializer 'frun)))
+
+ (resume-culling-for-block-percentage
+ (maybe-non-negative-integer 5)
+ "Start culling when available blocks drop below this percentage."
+ (serializer (make-percentage-threshold-serializer 'bcull)))
+
+ (resume-culling-for-file-percentage
+ (maybe-non-negative-integer 5)
+ "Start culling when available files drop below this percentage."
+ (serializer (make-percentage-threshold-serializer 'fcull)))
+
+ (pause-caching-for-block-percentage
+ (maybe-non-negative-integer 1)
+ "Pause further allocations when available blocks drop below this percentage."
+ (serializer (make-percentage-threshold-serializer 'bstop)))
+
+ (pause-caching-for-file-percentage
+ (maybe-non-negative-integer 1)
+ "Pause further allocations when available files drop below this percentage."
+ (serializer (make-percentage-threshold-serializer 'fstop)))
+
+ ;; run time optimizations in the configuration file
+ (log2-table-size
+ (maybe-non-negative-integer 12)
+ "Size of tables holding cullable objects in logarithm of base 2."
+ (serializer (make-option-serializer 'culltable)))
+
+ (cull?
+ (boolean #t)
+ "Create free space by culling (consumes system load)."
+ (serializer
+ (lambda (variable-symbol value)
+ (if value "" "nocull\n"))))
+
+ ;; kernel module debugging in the configuration file
+ (trace-function-entry-in-kernel-module?
+ (boolean #f)
+ "Trace function entry in the kernel module (for debugging)."
+ (serializer empty-serializer))
+
+ (trace-function-exit-in-kernel-module?
+ (boolean #f)
+ "Trace function exit in the kernel module (for debugging)."
+ (serializer empty-serializer))
+
+ (trace-internal-checkpoints-in-kernel-module?
+ (boolean #f)
+ "Trace internal checkpoints in the kernel module (for debugging)."
+ (serializer empty-serializer)))
+
+(define (serialize-cachefilesd-configuration configuration)
+ (mixed-text-file
+ "cachefilesd.conf"
+ (serialize-configuration configuration cachefilesd-configuration-fields)))
+
+(define (cachefilesd-shepherd-service config)
+ "Return a list of <shepherd-service> for cachefilesd for CONFIG."
+ (match-record
+ config <cachefilesd-configuration> (cachefilesd
+ debug-output?
+ use-syslog?
+ scan?
+ cache-directory)
+ (let ((configuration-file (serialize-cachefilesd-configuration config)))
+ (shepherd-service
+ (documentation "Run the cachefilesd daemon for FS-Cache.")
+ (provision '(cachefilesd))
+ (requirement (append '(file-systems)
+ (if use-syslog? '(syslogd) '())))
+ (start #~(begin
+ (and=> #$(maybe-value cache-directory) mkdir-p)
+ (make-forkexec-constructor
+ `(#$(file-append cachefilesd "/sbin/cachefilesd")
+ ;; do not detach
+ "-n"
+ #$@(if debug-output? '("-d") '())
+ #$@(if use-syslog? '() '("-s"))
+ #$@(if scan? '() '("-N"))
+ "-f" #$configuration-file))))
+ (stop #~(make-kill-destructor))))))
+
+(define cachefilesd-service-type
+ (service-type
+ (name 'cachefilesd)
+ (description
+ "Run the file system cache daemon @command{cachefilesd}, which relies on
+the Linux @code{cachefiles} module.")
+ (extensions
+ (list (service-extension kernel-module-loader-service-type
+ (const '("cachefiles")))
+ (service-extension shepherd-root-service-type
+ (compose list cachefilesd-shepherd-service))))
+ (default-value (cachefilesd-configuration))))
+
+
+;;;
;;; Reliability, Availability, and Serviceability (RAS) daemon
;;;
@@ -351,7 +550,7 @@ more information)."
;;;
-;;; Kernel module loader.
+;;; Zram device
;;;
(define-record-type* <zram-device-configuration>
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 2ef5980e09..cea68beef8 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;;
@@ -20,10 +20,8 @@
(define-module (gnu services mcron)
#:use-module (gnu services)
- #:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu packages guile-xyz)
- #:use-module (guix deprecation)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
@@ -37,6 +35,7 @@
mcron-configuration-log-file
mcron-configuration-log-format
mcron-configuration-date-format
+ mcron-configuration-home-service?
mcron-service-type))
@@ -55,40 +54,34 @@
;;;
;;; Code:
-(define list-of-gexps?
- (list-of gexp?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization mcron-configuration
- (mcron
- (file-like mcron)
- "The mcron package to use.")
-
- (jobs
- (list-of-gexps '())
- "This is a list of gexps (@pxref{G-Expressions}), where each gexp
-corresponds to an mcron job specification (@pxref{Syntax, mcron job
-specifications,, mcron, GNU@tie{}mcron}).")
-
- (log?
- (boolean #t)
- "Log messages to standard output.")
-
- (log-file
- (string "/var/log/mcron.log")
- "Log file location.")
-
- (log-format
- (string "~1@*~a ~a: ~a~%")
- "@code{(ice-9 format)} format string for log messages. The default value
-produces messages like @samp{@var{pid} @var{name}: @var{message}}
-(@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}).
-Each message is also prefixed by a timestamp by GNU Shepherd.")
-
- (date-format
- maybe-string
- "@code{(srfi srfi-19)} format string for date."))
+;; Configuration of mcron.
+;; XXX: 'define-configuration' cannot be used here due to the need for
+;; 'thunked' and 'innate' fields as well as 'this-mcron-configuration'.
+(define-record-type* <mcron-configuration> mcron-configuration
+ make-mcron-configuration
+ mcron-configuration?
+ this-mcron-configuration
+
+ (mcron mcron-configuration-mcron ;file-like
+ (default mcron))
+ (jobs mcron-configuration-jobs ;list of gexps
+ (default '()))
+ (log? mcron-configuration-log? ;Boolean
+ (default #t))
+ (log-file mcron-configuration-log-file ;string | gexp
+ (thunked)
+ (default
+ (if (mcron-configuration-home-service?
+ this-mcron-configuration)
+ #~(string-append %user-log-dir "/mcron.log")
+ "/var/log/mcron.log")))
+ (log-format mcron-configuration-log-format ;string
+ (default "~1@*~a ~a: ~a~%"))
+ (date-format mcron-configuration-date-format ;string | #f
+ (default #f))
+
+ (home-service? mcron-configuration-home-service?
+ (default for-home?) (innate)))
(define (job-files mcron jobs)
"Return a list of file-like object for JOBS, a list of gexps."
@@ -158,24 +151,27 @@ files."
(define (mcron-shepherd-services config)
(match-record config <mcron-configuration>
- (mcron jobs log? log-file log-format date-format)
+ (mcron jobs log? log-file log-format date-format home-service?)
(if (eq? jobs '())
'() ;nothing to do
(let ((files (job-files mcron jobs)))
(list (shepherd-service
(provision '(mcron))
- (requirement '(user-processes))
+ (requirement (if home-service?
+ '()
+ '(user-processes)))
(modules `((srfi srfi-1)
(srfi srfi-26)
(ice-9 popen) ;for the 'schedule' action
(ice-9 rdelim)
(ice-9 match)
+ ((shepherd support) #:select (%user-log-dir))
,@%default-modules))
(start #~(make-forkexec-constructor
(list #$(file-append mcron "/bin/mcron")
#$@(if log?
`("--log" "--log-format" ,log-format
- ,@(if (maybe-value-set? date-format)
+ ,@(if date-format
(list "--date-format"
date-format)
'()))
@@ -209,15 +205,10 @@ files."
(extend (lambda (config jobs)
(mcron-configuration
(inherit config)
+ (home-service?
+ (mcron-configuration-home-service? config))
(jobs (append (mcron-configuration-jobs config)
jobs)))))
(default-value (mcron-configuration)))) ;empty job list
-
-;;;
-;;; Generate documentation.
-;;;
-(define (generate-doc)
- (configuration->documentation 'mcron-configuration))
-
;;; mcron.scm ends here
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index dbb9d0285f..b3a02e82e9 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -94,7 +94,7 @@
(define optional-pam-mount
(pam-entry
(control "optional")
- (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
+ (module (file-append pam-mount "/lib/security/pam_mount.so"))))
(list
(pam-extension
(transformer
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index c9a7ba96f4..69c737829b 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -171,7 +171,16 @@ Relogin=" (if (sddm-configuration-relogin? config)
(documentation "SDDM display manager.")
(requirement '(user-processes elogind pam))
(provision '(xorg-server display-manager))
- (start #~(make-forkexec-constructor #$sddm-command))
+ (start #~(make-forkexec-constructor
+ #$sddm-command
+ ;; some theme need icon,qml,data so add path to env.
+ #:environment-variables
+ (cons*
+ "XDG_DATA_DIRS=/run/current-system/profile/share"
+ "XDG_CONFIG_DIRS=/run/current-system/profile/etc/xdg"
+ "QT_PLUGIN_PATH=/run/current-system/profile/lib/qt5/plugins"
+ "QML2_IMPORT_PATH=/run/current-system/profile/lib/qt5/qml"
+ (default-environment-variables))))
(stop #~(make-kill-destructor)))))
(define (sddm-etc-service config)
diff --git a/gnu/services/syncthing.scm b/gnu/services/syncthing.scm
index c1a0cdd81f..2f7c822827 100644
--- a/gnu/services/syncthing.scm
+++ b/gnu/services/syncthing.scm
@@ -49,35 +49,41 @@
(group syncthing-configuration-group ;string
(default "users"))
(home syncthing-configuration-home ;string
- (default #f)))
+ (default #f))
+ (home-service? syncthing-configuration-home-service?
+ (default for-home?) (innate)))
(define syncthing-shepherd-service
- (match-lambda
- (($ <syncthing-configuration> syncthing arguments logflags user group home)
- (list
- (shepherd-service
- (provision (list (string->symbol (string-append "syncthing-" user))))
- (documentation "Run syncthing.")
- (requirement '(loopback))
- (start #~(make-forkexec-constructor
- (append (list (string-append #$syncthing "/bin/syncthing")
- "--no-browser"
- "--no-restart"
- (string-append "--logflags=" (number->string #$logflags)))
- '#$arguments)
- #:user #$user
- #:group #$group
- #:environment-variables
- (append (list (string-append "HOME=" (or #$home (passwd:dir (getpw #$user))))
- "SSL_CERT_DIR=/etc/ssl/certs"
- "SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt")
- (remove (lambda (str)
+ (match-record-lambda <syncthing-configuration>
+ (syncthing arguments logflags user group home home-service?)
+ (list
+ (shepherd-service
+ (provision (if home-service?
+ '(syncthing)
+ (list (string->symbol
+ (string-append "syncthing-" user)))))
+ (documentation "Run syncthing.")
+ (requirement (if home-service? '() '(loopback)))
+ (start #~(make-forkexec-constructor
+ (append (list (string-append #$syncthing "/bin/syncthing")
+ "--no-browser"
+ "--no-restart"
+ (string-append "--logflags=" (number->string #$logflags)))
+ '#$arguments)
+ #:user #$(and (not home-service?) user)
+ #:group #$(and (not home-service?) group)
+ #:environment-variables
+ (append (list (string-append "HOME=" (or #$home (passwd:dir (getpw #$user))))
+ "SSL_CERT_DIR=/etc/ssl/certs"
+ "SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt")
+ (filter (negate ;XXX: 'remove' is not in (guile)
+ (lambda (str)
(or (string-prefix? "HOME=" str)
(string-prefix? "SSL_CERT_DIR=" str)
- (string-prefix? "SSL_CERT_FILE=" str)))
- (environ)))))
- (respawn? #f)
- (stop #~(make-kill-destructor)))))))
+ (string-prefix? "SSL_CERT_FILE=" str))))
+ (environ)))))
+ (respawn? #f)
+ (stop #~(make-kill-destructor))))))
(define syncthing-service-type
(service-type (name 'syncthing)
generated by cgit