From e63c87020d10f90d5461cec2b7f83f5d20773603 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 5 Jul 2023 10:19:15 +0200 Subject: services: Add 'file-database' service. * gnu/services/admin.scm (%default-file-database-update-schedule) (%default-file-database-excluded-directories): New variables. (): New record type. (file-database-mcron-jobs): New procedure. (file-database-service-type): New variable. * doc/guix.texi (File Search Services): New node. --- gnu/services/admin.scm | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) (limited to 'gnu/services') diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index 1c10cfb1f6..004ac8c910 100644 --- a/gnu/services/admin.scm +++ b/gnu/services/admin.scm @@ -21,16 +21,21 @@ (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 ((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 +60,15 @@ 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 + unattended-upgrade-service-type unattended-upgrade-configuration unattended-upgrade-configuration? @@ -255,6 +269,75 @@ Old log files are removed or compressed according to the configuration.") (description "Periodically delete old log files."))) + +;;; +;;; 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 + (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)))) + ;;; ;;; Unattended upgrade. -- cgit v1.2.3 From b3a2b3e7238161ebd86c7609f68e8f1e9c1dd6b7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 5 Jul 2023 11:49:34 +0200 Subject: services: Add 'package-database' service. * gnu/services/admin.scm (%default-package-database-update-schedule): New variable. (): New record type. (package-database-mcron-jobs): New procedure. (package-database-service-type): New variable. * doc/guix.texi (File Search Services): Document it. --- doc/guix.texi | 49 +++++++++++++++++++++++++++++++++++++++++++++- gnu/services/admin.scm | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 101 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index cbec8b0708..65ca18a1be 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4481,7 +4481,9 @@ database, usually under @file{/var/cache/guix/locate}; if it does not exist or is too old, it falls back to the per-user database, by default under @file{~/.cache/guix/locate}. On a multi-user system, administrators may want to periodically update the system-wide database -so that all users can benefit from it. +so that all users can benefit from it, for instance by setting up +@code{package-database-service-type} (@pxref{File Search Services, +@code{package-database-service-type}}). The general syntax is: @@ -25000,6 +25002,51 @@ GNU@tie{}Findutils}). @end table @end deftp +The second service, @code{package-database-service-type}, builds the +database used by @command{guix locate}, which lets you search for +packages that contain a given file (@pxref{Invoking guix locate}). The +service periodically updates a system-wide database, which will be +readily available to anyone running @command{guix locate} on the system. +To use this service with its default settings, add this snippet to your +service list: + +@lisp +(service package-database-service-type) +@end lisp + +This will run @command{guix locate --update} once a week. + +@defvar package-database-service-type +This is the service type for periodic @command{guix locate} updates +(@pxref{Invoking guix locate}). Its value must be a +@code{package-database-configuration} record, as shown below. +@end defvar + +@deftp {Data Type} package-database-configuration +Data type to configure periodic package database updates. It has the +following fields: + +@table @asis +@item @code{package} (default: @code{guix}) +The Guix package to use. + +@item @code{schedule} (default: @code{%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}). + +@item @code{method} (default: @code{'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. + +@item @code{channels} (default: @code{#~%default-channels}) +G-exp denoting the channels to use when updating the database +(@pxref{Channels}). +@end table +@end deftp + + @node Database Services @subsection Database Services diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index 004ac8c910..edd8ce59da 100644 --- a/gnu/services/admin.scm +++ b/gnu/services/admin.scm @@ -29,6 +29,8 @@ #: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) @@ -69,6 +71,14 @@ %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? @@ -338,6 +348,49 @@ 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 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. -- cgit v1.2.3 From 969cea683615e79c7e6548f945f15af80ad58a8a Mon Sep 17 00:00:00 2001 From: Sam Lockart Date: Sat, 24 Jun 2023 03:11:26 +0000 Subject: file-systems: Use cgroups v2. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit cgroup v2 is the next generation of the control groups API. This patch replaces the cgroup v1 file systems with the unified cgroup v2 file system. cgroup v2 allows for things like containerd/podman to run rootless containers and opens guix system up to running things like Kubernetes. Thanks to Hilton Chain for suggesting the Docker service change. * gnu/system/file-systems.scm (%control-groups): Change to a single "cgroup2" mount point. * gnu/services/docker.scm (docker-shepherd-service): Trim 'requirement' field accordingly. Co-authored-by: Ludovic Courtès --- gnu/services/docker.scm | 7 +------ gnu/system/file-systems.scm | 27 +++++++-------------------- 2 files changed, 8 insertions(+), 26 deletions(-) (limited to 'gnu/services') 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/system/file-systems.scm b/gnu/system/file-systems.scm index 0ff5a0dcf6..95b757a698 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -445,26 +445,13 @@ TARGET in the other system." (flags '(read-only bind-mount no-atime)))) (define %control-groups - (let ((parent (file-system - (device "cgroup") - (mount-point "/sys/fs/cgroup") - (type "tmpfs") - (check? #f)))) - (cons parent - (map (lambda (subsystem) - (file-system - (device "cgroup") - (mount-point (string-append "/sys/fs/cgroup/" subsystem)) - (type "cgroup") - (check? #f) - (options subsystem) - (create-mount-point? #t) - - ;; This must be mounted after, and unmounted before the - ;; parent directory. - (dependencies (list parent)))) - '("cpuset" "cpu" "cpuacct" "memory" "devices" "freezer" - "blkio" "perf_event" "pids"))))) + ;; The cgroup2 file system. + (list (file-system + (device "none") + (mount-point "/sys/fs/cgroup") + (type "cgroup2") + (check? #f) + (create-mount-point? #f)))) (define %elogind-file-systems ;; We don't use systemd, but these file systems are needed for elogind, -- cgit v1.2.3 From 8a88b8b0b5924f8ed00a49e79714cb005cffc7cb Mon Sep 17 00:00:00 2001 From: Brian Cully Date: Tue, 18 Jul 2023 10:06:16 -0400 Subject: services: Add pam-mount-volume-service-type. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The `pam-mount-volumes-service-type' adds additional volumes to the pam-mount-service-type in addition to any that are already specified in `pam-mount-rules'. * doc/guix.texi (PAM Mount Volume Service): add documentation for `pam-mount-service-type'. * gnu/services/pam-mount.scm: new file. * Makefile.am: add pam-mount tests * tests/services/pam-mount.scm: new tests Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + doc/guix.texi | 99 +++++++++++++++++++++++++++++++++++++ gnu/services/pam-mount.scm | 114 ++++++++++++++++++++++++++++++++++++++++++- tests/services/pam-mount.scm | 83 +++++++++++++++++++++++++++++++ 4 files changed, 296 insertions(+), 1 deletion(-) create mode 100644 tests/services/pam-mount.scm (limited to 'gnu/services') diff --git a/Makefile.am b/Makefile.am index ca9ec48fa3..693e14effe 100644 --- a/Makefile.am +++ b/Makefile.am @@ -559,6 +559,7 @@ SCM_TESTS = \ tests/services/configuration.scm \ tests/services/lightdm.scm \ tests/services/linux.scm \ + tests/services/pam-mount.scm \ tests/services/telephony.scm \ tests/services/vpn.scm \ tests/sets.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 65ca18a1be..71f9f29169 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -116,6 +116,7 @@ Copyright @copyright{} 2022 Antero Mejr@* Copyright @copyright{} 2023 Karl Hallsby@* Copyright @copyright{} 2023 Nathaniel Nicandro@* Copyright @copyright{} 2023 Tanguy Le Carrour@* +Copyright @copyright{} 2023 Brian Cully@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -37927,6 +37928,104 @@ The complete list of possible options can be found in the man page for @end table @end deftp +@subheading PAM Mount Volume Service +@cindex pam volume mounting + +PAM mount volumes are automatically mounted at login by the PAM login +service according to a set of per-volume rules. Because they are +mounted by PAM the password entered during login may be used directly to +mount authenticated volumes, such as @code{cifs}, using the same +credentials. + +These volumes will be added in addition to any volumes directly +specified in @code{pam-mount-rules}. + +Here is an example of a rule which will mount a remote CIFS share from +@file{//remote-server/share} into a sub-directory of @file{/shares} +named after the user logging in: + +@lisp +(simple-service 'pam-mount-remote-share pam-mount-volume-service-type + (list (pam-mount-volume + (secondary-group "users") + (file-system-type "cifs") + (server "remote-server") + (file-name "share") + (mount-point "/shares/%(USER)") + (options "nosuid,nodev,seal,cifsacl")))) +@end lisp + +@deftp {Data Type} pam-mount-volume-service-type +Configuration for a single volume to be mounted. Any fields not +specified will be omitted from the run-time PAM configuration. See +@uref{http://pam-mount.sourceforge.net/pam_mount.conf.5.html, +the man page} for the default values when unspecified. + +@table @asis +@item @code{user-name} (type: maybe-string) +Mount the volume for the given user. + +@item @code{user-id} (type: maybe-integer-or-range) +Mount the volume for the user with this ID. This field may also be +specified as a pair of @code{(start . end)} indicating a range of user +IDs for whom to mount the volume. + +@item @code{primary-group} (type: maybe-string) +Mount the volume for users with this primary group name. + +@item @code{group-id} (type: maybe-integer-or-range) +Mount the volume for the users with this primary group ID. This field +may also be specified as a cons cell of @code{(start . end)} indicating +a range of group ids for whom to mount the volume. + +@item @code{secondary-group} (type: maybe-string) +Mount the volume for users who are members of this group as either a +primary or secondary group. + +@item @code{file-system-type} (type: maybe-string) +The file system type for the volume being mounted (e.g., @code{cifs}) + +@item @code{no-mount-as-root?} (type: maybe-boolean) +Whether or not to mount the volume with root privileges. This is +normally disabled, but may be enabled for mounts of type @code{fuse}, or +other user-level mounts. + +@item @code{server} (type: maybe-string) +The name of the remote server to mount the volume from, when necessary. + +@item @code{file-name} (type: maybe-string) +The location of the volume, either local or remote, depending on the +@code{file-system-type}. + +@item @code{mount-point} (type: maybe-string) +Where to mount the volume in the local file-system. This may be set to +@file{~} to indicate the home directory of the user logging in. If this +field is omitted then @file{/etc/fstab} is consulted for the mount +destination. + +@item @code{options} (type: maybe-string) +The options to be passed as-is to the underlying mount program. + +@item @code{ssh?} (type: maybe-boolean) +Enable this option to pass the login password to SSH for use with mounts +involving SSH (e.g., @code{sshfs}). + +@item @code{cipher} (type: maybe-string) +Cryptsetup cipher name for the volume. To be used with the @code{crypt} +@code{file-system-type}. + +@item @code{file-system-key-cipher} (type: maybe-string) +Cipher name used by the target volume. + +@item @code{file-system-key-hash} (type: maybe-string) +SSL hash name used by the target volume. + +@item @code{file-system-key-file-name} (type: maybe-string) +File name of the file system key for the target volume. + +@end table +@end deftp + @node Guix Services @subsection Guix Services diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm index 21c34ddd61..dbb9d0285f 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 +;;; Copyright © 2023 Brian Cully ;;; ;;; 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"))) @@ -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/tests/services/pam-mount.scm b/tests/services/pam-mount.scm new file mode 100644 index 0000000000..bfbd15967f --- /dev/null +++ b/tests/services/pam-mount.scm @@ -0,0 +1,83 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Brian Cully +;;; +;;; 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 . + +(define-module (tests services pam-mount) + #:use-module (gnu services pam-mount) + #:use-module (gnu system pam) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix grafts) + #:use-module (guix store) + #:use-module (guix tests) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +(define pam-mount-volume-fields (@@ (gnu services pam-mount) + pam-mount-volume-fields)) +(define field-name->tag (@@ (gnu services pam-mount) + field-name->tag)) + +(define pam-mount-volume->sxml (@@ (gnu services pam-mount) + pam-mount-volume->sxml)) + +(test-begin "services-pam-mount") + +(test-group "field-name->tag" + (let ((field-map '((user-name user) + (user-id uid) + (primary-group pgrp) + (group-id gid) + (secondary-group sgrp) + (file-system-type fstype) + (no-mount-as-root? noroot) + (server server) + (file-name path) + (mount-point mountpoint) + (options options) + (ssh? ssh) + (cipher cipher) + (file-system-key-cipher fskeycipher) + (file-system-key-hash fskeyhash) + (file-system-key-file-name fskeypath)))) + + (test-equal "all fields accounted for" + (map car field-map) + (map configuration-field-name pam-mount-volume-fields)) + + (for-each (match-lambda + ((field-name tag-name) + (test-eq (format #f "~a -> ~a" field-name tag-name) + (field-name->tag field-name) tag-name))) + field-map))) + +(let ((tmpfs-volume (pam-mount-volume + (secondary-group "users") + (file-system-type "tmpfs") + (mount-point "/run/user/%(USERUID)") + (options "someoptions")))) + (test-equal "tmpfs" + '(volume (@ (sgrp "users") + (fstype "tmpfs") + (mountpoint "/run/user/%(USERUID)") + (options "someoptions"))) + (pam-mount-volume->sxml tmpfs-volume))) + +(test-end "services-pam-mount") -- cgit v1.2.3 From 71aba798d3d586a42afe8a61e8e36b95ca41bc37 Mon Sep 17 00:00:00 2001 From: Miguel Moreno Date: Mon, 27 Mar 2023 19:30:45 +0200 Subject: services: postgresql: Add more role fields. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/databases.scm (postgresql-role): Add more role fields. (postgresql-create-roles): Honor it. * doc/guix.texi (Database Services): Document it. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 16 +++++++++++++++- gnu/services/databases.scm | 19 ++++++++++++++++--- 2 files changed, 31 insertions(+), 4 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 71f9f29169..409ca2ad62 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25258,7 +25258,21 @@ The role permissions list. Supported permissions are @code{bypassrls}, @code{superuser}. @item @code{create-database?} (default: @code{#f}) -Whether to create a database with the same name as the role. +whether to create a database with the same name as the role. + +@item @code{encoding} (default: @code{"UTF8"}) +The character set to use for storing text in the database. + +@item @code{collation} (default: @code{"en_US.utf8"}) +The string sort order locale setting. + +@item @code{ctype} (default: @code{"en_US.utf8"}) +The character classification locale setting. + +@item @code{template} (default: @code{"template1"}) +The default template to copy the new database from when creating it. +Use @code{"template0"} for a pristine database with no system-local +modifications. @end table @end deftp diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index e8e42d3b7b..7148971c1d 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -363,7 +363,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 make-postgresql-role-configuration @@ -392,7 +400,8 @@ and stores the database cluster in @var{data-directory}." (append-map (lambda (role) (match-record 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 +411,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))) -- cgit v1.2.3 From 56fddefc6de3b0c1f2ccb9559d86ba08d2e429b9 Mon Sep 17 00:00:00 2001 From: terramorpha Date: Thu, 13 Jul 2023 16:16:51 -0400 Subject: services: syncthing: Use the new command line syntax. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/syncthing.scm (syncthing-shepherd-service): Use the new command line syntax. Signed-off-by: Ludovic Courtès --- gnu/services/syncthing.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'gnu/services') 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 +;;; Copyright © 2023 Justin Veilleux ;;; ;;; 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 -- cgit v1.2.3