summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/admin.scm136
-rw-r--r--gnu/services/authentication.scm2
-rw-r--r--gnu/services/base.scm65
-rw-r--r--gnu/services/databases.scm56
-rw-r--r--gnu/services/desktop.scm57
-rw-r--r--gnu/services/dns.scm168
-rw-r--r--gnu/services/docker.scm7
-rw-r--r--gnu/services/kerberos.scm4
-rw-r--r--gnu/services/linux.scm199
-rw-r--r--gnu/services/pam-mount.scm116
-rw-r--r--gnu/services/sddm.scm11
-rw-r--r--gnu/services/syncthing.scm7
12 files changed, 596 insertions, 232 deletions
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 1c10cfb1f6..edd8ce59da 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -21,16 +21,23 @@
(define-module (gnu services admin)
#:use-module (gnu packages admin)
+ #:use-module ((gnu packages base)
+ #:select (canonical-package findutils))
#:use-module (gnu packages certs)
#:use-module (gnu packages package-management)
#:use-module (gnu services)
+ #:use-module (gnu services configuration)
#:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
+ #:use-module (gnu system accounts)
+ #:use-module ((gnu system shadow) #:select (account-service-type))
+ #:use-module ((guix store) #:select (%store-prefix))
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:export (%default-rotations
%rotated-files
@@ -55,6 +62,23 @@
log-cleanup-configuration-expiry
log-cleanup-configuration-schedule
+ file-database-service-type
+ file-database-configuration
+ file-database-configuration?
+ file-database-configuration-package
+ file-database-configuration-schedule
+ file-database-configuration-excluded-directories
+ %default-file-database-update-schedule
+ %default-file-database-excluded-directories
+
+ package-database-service-type
+ package-database-configuration
+ package-database-configuration?
+ package-database-configuration-package
+ package-database-configuration-schedule
+ package-database-configuration-method
+ package-database-configuration-channels
+
unattended-upgrade-service-type
unattended-upgrade-configuration
unattended-upgrade-configuration?
@@ -257,6 +281,118 @@ Old log files are removed or compressed according to the configuration.")
;;;
+;;; File databases.
+;;;
+
+(define %default-file-database-update-schedule
+ ;; Default mcron schedule for the periodic 'updatedb' job: once every
+ ;; Sunday.
+ "10 23 * * 0")
+
+(define %default-file-database-excluded-directories
+ ;; Directories excluded from the 'locate' database.
+ (list (%store-prefix)
+ "/tmp" "/var/tmp" "/var/cache" ".*/\\.cache"
+ "/run/udev"))
+
+(define (string-or-gexp? obj)
+ (or (string? obj) (gexp? obj)))
+
+(define string-list?
+ (match-lambda
+ (((? string?) ...) #t)
+ (_ #f)))
+
+(define-configuration/no-serialization file-database-configuration
+ (package
+ (file-like (let-system (system target)
+ ;; Unless we're cross-compiling, avoid pulling a second copy
+ ;; of findutils.
+ (if target
+ findutils
+ (canonical-package findutils))))
+ "The GNU@tie{}Findutils package from which the @command{updatedb} command
+is taken.")
+ (schedule
+ (string-or-gexp %default-file-database-update-schedule)
+ "String or G-exp denoting an mcron schedule for the periodic
+@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
+@command{updatedb} (@pxref{Invoking updatedb,,, find, GNU@tie{}Findutils})."))
+
+(define (file-database-mcron-jobs configuration)
+ (match-record configuration <file-database-configuration>
+ (package schedule excluded-directories)
+ (let ((updatedb (program-file
+ "updatedb"
+ #~(execl #$(file-append package "/bin/updatedb")
+ "updatedb"
+ #$(string-append "--prunepaths="
+ (string-join
+ excluded-directories))))))
+ (list #~(job #$schedule #$updatedb)))))
+
+(define file-database-service-type
+ (service-type
+ (name 'file-database)
+ (extensions (list (service-extension mcron-service-type
+ file-database-mcron-jobs)))
+ (description
+ "Periodically update the file database used by the @command{locate} command,
+which lets you search for files by name. The database is created by running
+the @command{updatedb} command.")
+ (default-value (file-database-configuration))))
+
+(define %default-package-database-update-schedule
+ ;; Default mcron schedule for the periodic 'guix locate --update' job: once
+ ;; every Monday.
+ "10 23 * * 1")
+
+(define-configuration/no-serialization package-database-configuration
+ (package (file-like guix)
+ "The Guix package to use.")
+ (schedule (string-or-gexp
+ %default-package-database-update-schedule)
+ "String or G-exp denoting an mcron schedule for the periodic
+@command{guix locate --update} job (@pxref{Guile Syntax,,, mcron,
+GNU@tie{}mcron}).")
+ (method (symbol 'store)
+ "Indexing method for @command{guix locate}. The default value,
+@code{'store}, yields a more complete database but is relatively expensive in
+terms of CPU and input/output.")
+ (channels (gexp #~%default-channels)
+ "G-exp denoting the channels to use when updating the database
+(@pxref{Channels})."))
+
+(define (package-database-mcron-jobs configuration)
+ (match-record configuration <package-database-configuration>
+ (package schedule method channels)
+ (let ((channels (scheme-file "channels.scm" channels)))
+ (list #~(job #$schedule
+ ;; XXX: The whole thing's running as "root" just because it
+ ;; needs write access to /var/cache/guix/locate.
+ (string-append #$(file-append package "/bin/guix")
+ " time-machine -C " #$channels
+ " -- locate --update --method="
+ #$(symbol->string method)))))))
+
+(define package-database-service-type
+ (service-type
+ (name 'package-database)
+ (extensions (list (service-extension mcron-service-type
+ package-database-mcron-jobs)))
+ (description
+ "Periodically update the package database used by the @code{guix locate} command,
+which lets you search for packages that provide a given file.")
+ (default-value (package-database-configuration))))
+
+
+;;;
;;; Unattended upgrade.
;;;
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 e8e42d3b7b..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))))
@@ -363,7 +376,15 @@ and stores the database cluster in @var{data-directory}."
(permissions postgresql-role-permissions
(default '(createdb login))) ;list
(create-database? postgresql-role-create-database? ;boolean
- (default #f)))
+ (default #f))
+ (encoding postgresql-role-encoding ;string
+ (default "UTF8"))
+ (collation postgresql-role-collation ;string
+ (default "en_US.utf8"))
+ (ctype postgresql-role-ctype ;string
+ (default "en_US.utf8"))
+ (template postgresql-role-template ;string
+ (default "template1")))
(define-record-type* <postgresql-role-configuration>
postgresql-role-configuration make-postgresql-role-configuration
@@ -392,7 +413,8 @@ and stores the database cluster in @var{data-directory}."
(append-map
(lambda (role)
(match-record role <postgresql-role>
- (name permissions create-database?)
+ (name permissions create-database? encoding collation ctype
+ template)
`("SELECT NOT(EXISTS(SELECT 1 FROM pg_catalog.pg_roles WHERE \
rolname = '" ,name "')) as not_exists;\n"
"\\gset\n"
@@ -402,7 +424,11 @@ rolname = '" ,name "')) as not_exists;\n"
";\n"
,@(if create-database?
`("CREATE DATABASE \"" ,name "\""
- " OWNER \"" ,name "\";\n")
+ " OWNER \"" ,name "\"\n"
+ " ENCODING '" ,encoding "'\n"
+ " LC_COLLATE '" ,collation "'\n"
+ " LC_CTYPE '" ,ctype "'\n"
+ " TEMPLATE " ,template ";")
'())
"\\endif\n")))
roles)))
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 <[email protected]>
;;; Copyright © 2017, 2020, 2022, 2023 Maxim Cournoyer <[email protected]>
;;; Copyright © 2017 Nikita <[email protected]>
+;;; Copyright © 2017, 2019 Hartmut Goebel <[email protected]>
;;; Copyright © 2018, 2020, 2022 Efraim Flashner <[email protected]>
;;; Copyright © 2018, 2023 Ricardo Wurmus <[email protected]>
;;; Copyright © 2017, 2019 Christopher Baines <[email protected]>
@@ -15,6 +16,7 @@
;;; Copyright © 2021 Brice Waegeneire <[email protected]>
;;; Copyright © 2021, 2022 muradm <[email protected]>
;;; Copyright © 2023 Bruno Victal <[email protected]>
+;;; Copyright © 2023 Zheng Junjie <[email protected]>
;;;
;;; 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/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 <[email protected]>
-;;; Copyright © 2018 Oleg Pykhalov <[email protected]>
;;; Copyright © 2020 Pierre Langlois <[email protected]>
;;; Copyright © 2021 Maxime Devos <[email protected]>
;;; Copyright © 2022 Remco van 't Veer <[email protected]>
@@ -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/docker.scm b/gnu/services/docker.scm
index 741bab5a8c..c2023d618c 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -116,12 +116,7 @@ loop-back communications.")
(requirement '(containerd
dbus-system
elogind
- file-system-/sys/fs/cgroup/blkio
- file-system-/sys/fs/cgroup/cpu
- file-system-/sys/fs/cgroup/cpuset
- file-system-/sys/fs/cgroup/devices
- file-system-/sys/fs/cgroup/memory
- file-system-/sys/fs/cgroup/pids
+ file-system-/sys/fs/cgroup
networking
udev))
(start #~(make-forkexec-constructor
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..d17f492e15 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2021 B. Wilson <[email protected]>
;;; Copyright © 2022 Josselin Poiret <[email protected]>
;;; Copyright © 2023 Bruno Victal <[email protected]>
+;;; Copyright © 2023 Felix Lechner <[email protected]>
;;;
;;; 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?
@@ -308,6 +331,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 +548,7 @@ more information)."
;;;
-;;; Kernel module loader.
+;;; Zram device
;;;
(define-record-type* <zram-device-configuration>
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
index 21c34ddd61..b3a02e82e9 100644
--- a/gnu/services/pam-mount.scm
+++ b/gnu/services/pam-mount.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Guillaume Le Vaillant <[email protected]>
+;;; Copyright © 2023 Brian Cully <[email protected]>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,9 +24,15 @@
#:use-module (gnu system pam)
#:use-module (guix gexp)
#:use-module (guix records)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
#:export (pam-mount-configuration
pam-mount-configuration?
- pam-mount-service-type))
+ pam-mount-service-type
+
+ pam-mount-volume
+ pam-mount-volume?
+ pam-mount-volume-service-type))
(define %pam-mount-default-configuration
`((debug (@ (enable "0")))
@@ -87,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
@@ -102,6 +109,11 @@
(list optional-pam-mount))))
pam))))))
+(define (extend-pam-mount-configuration initial extensions)
+ "Extends INITIAL with EXTENSIONS."
+ (pam-mount-configuration (rules (append (pam-mount-configuration-rules
+ initial) extensions))))
+
(define pam-mount-service-type
(service-type
(name 'pam-mount)
@@ -109,6 +121,106 @@
pam-mount-etc-service)
(service-extension pam-root-service-type
pam-mount-pam-service)))
+ (compose concatenate)
+ (extend extend-pam-mount-configuration)
(default-value (pam-mount-configuration))
(description "Activate PAM-Mount support. It allows mounting volumes for
specific users when they log in.")))
+
+(define (field-name->tag field-name)
+ "Convert FIELD-NAME to its tag used by the configuration XML."
+ (match field-name
+ ('user-name 'user)
+ ('user-id 'uid)
+ ('primary-group 'pgrp)
+ ('group-id 'gid)
+ ('secondary-group 'sgrp)
+ ('file-system-type 'fstype)
+ ('no-mount-as-root? 'noroot)
+ ('file-name 'path)
+ ('mount-point 'mountpoint)
+ ('ssh? 'ssh)
+ ('file-system-key-cipher 'fskeycipher)
+ ('file-system-key-hash 'fskeyhash)
+ ('file-system-key-file-name 'fskeypath)
+ (_ field-name)))
+
+(define-maybe string)
+
+(define (serialize-string field-name value)
+ (list (field-name->tag field-name) value))
+
+(define (integer-or-range? value)
+ (match value
+ ((start . end) (and (integer? start)
+ (integer? end)))
+ (_ (number? value))))
+
+(define-maybe integer-or-range)
+
+(define (serialize-integer-or-range field-name value)
+ (let ((value-string (match value
+ ((start . end) (format #f "~a-~a" start end))
+ (_ (number->string value)))))
+ (list (field-name->tag field-name) value-string)))
+
+(define-maybe boolean)
+
+(define (serialize-boolean field-name value)
+ (let ((value-string (if value "1" "0")))
+ (list (field-name->tag field-name) value-string)))
+
+(define-configuration pam-mount-volume
+ (user-name maybe-string "User name to match.")
+ (user-id maybe-integer-or-range
+ "User ID, or range of user IDs, in the form of @code{(start . end)} to\nmatch.")
+ (primary-group maybe-string "Primary group name to match.")
+ (group-id maybe-integer-or-range
+ "Group ID, or range of group IDs, in the form of @code{(start . end)} to\nmatch.")
+ (secondary-group maybe-string
+ "Match users who belong to this group name as either a primary or secondary\ngroup.")
+ (file-system-type maybe-string "File system type of volume being mounted.")
+ (no-mount-as-root? maybe-boolean
+ "Do not use super user privileges to mount this volume.")
+ (server maybe-string "Remote server this volume resides on.")
+ (file-name maybe-string "Location of the volume to be mounted.")
+ (mount-point maybe-string
+ "Where to mount the volume in the local file system.")
+ (options maybe-string "Options to pass to the underlying mount program.")
+ (ssh? maybe-boolean "Whether to pass the login password to SSH.")
+ (cipher maybe-string "Cryptsetup cipher named used by volume.")
+ (file-system-key-cipher maybe-string
+ "Cipher name used by the target volume.")
+ (file-system-key-hash maybe-string
+ "SSL hash name used by the target volume.")
+ (file-system-key-file-name maybe-string
+ "File name for the file system key used by the target volume."))
+
+(define (pam-mount-volume->sxml volume)
+ ;; Convert a list of configuration fields into an SXML-compatible attribute
+ ;; list.
+ (define xml-attrs
+ (filter-map (lambda (field)
+ (let* ((accessor (configuration-field-getter field))
+ (value (accessor volume)))
+ (and (not (eq? value %unset-value))
+ (list (field-name->tag (configuration-field-name
+ field)) value))))
+ pam-mount-volume-fields))
+
+ `(volume (@ ,@xml-attrs)))
+
+(define (pam-mount-volume-rules volumes)
+ (map pam-mount-volume->sxml volumes))
+
+(define pam-mount-volume-service-type
+ (service-type (name 'pam-mount-volume)
+ (extensions (list (service-extension pam-mount-service-type
+ pam-mount-volume-rules)))
+ (compose concatenate)
+ (extend append)
+ (default-value '())
+ (description
+ "Mount remote volumes such as CIFS shares @i{via}
+@acronym{PAM, Pluggable Authentication Modules} when logging in, using login
+credentials.")))
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 7c3d5b027d..c1a0cdd81f 100644
--- a/gnu/services/syncthing.scm
+++ b/gnu/services/syncthing.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Oleg Pykhalov <[email protected]>
+;;; Copyright © 2023 Justin Veilleux <[email protected]>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -60,9 +61,9 @@
(requirement '(loopback))
(start #~(make-forkexec-constructor
(append (list (string-append #$syncthing "/bin/syncthing")
- "-no-browser"
- "-no-restart"
- (string-append "-logflags=" (number->string #$logflags)))
+ "--no-browser"
+ "--no-restart"
+ (string-append "--logflags=" (number->string #$logflags)))
'#$arguments)
#:user #$user
#:group #$group
generated by cgit v1.2.3 (git 2.45.2) at 2025-05-04 04:35:17 +0000