bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 12:05:19 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: Add vfs-mapping-service-type.

Browse source 
* gnu/services/linux.scm (vfs-mapping-service-type, vfs-mapping-configuration,
vfs-mapping-binding): New variables.
* doc/guix.texi: (Vfs Mapping Service): New subsubsection under "Linux Services".

Change-Id: I7ebd48afb809ded9fa6fe9eb80c618accb856716
Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
This commit is contained in:
Edouard Klein 2025-07-25 11:01:36 +02:00 • committed by Maxim Cournoyer
parent 8636c0910f
commit f05f8fb6b4
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 305 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

143
doc/guix.texi
View file

@ -142,6 +142,7 @@ Copyright @copyright{} 2025 Sergio Pastor Pérez@*
Copyright @copyright{} 2024 Evgeny Pisemsky@*
Copyright @copyright{} 2025 jgart@*
Copyright @copyright{} 2025 Artur Wroblewski@*
Copyright @copyright{} 2025 Edouard Klein@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -43401,6 +43402,148 @@ this value will override the @code{ttl} when used for narinfo requests.
@node Linux Services
@subsection Linux Services
@subsubheading VFS Mapping Service
@cindex VFS mapping
@cindex Virtual File System mapping
@cindex bind mounts, service
@cindex overlay mounts, service
The VFS (Virtual File System) Mapping service allows you to bind a file
name under a different name in the global namespace. For example, this
is used by the Shared Cache Service (@pxref{Guix Services}) to bind the
@samp{root} user's cache over another user's cache. Another use case
may be to expose game data from the store over your home directory, and
apply modifications there.
The service has three @emph{policies} to choose from with respect to
access rights on the bound over path:
@table @code
@item 'bind
Use a bind mount; the ownership and file
permissions of the destination are the same as the source.
@item 'translate
Use bindfs to make the destination appear as owned by the target user
and group. Writes will be propagated back to the source as if made by
the original owner.
@item 'overlay
Use an overlay to make the destination appear as owned by the target
user and group. Writes will not appear in the source, but will be stored
in a target-user-owned @samp{-overlay} suffixed directory near the
destination.
@end table
Here is an example configuration that exposes the default data directory
of @command{tuxpaint} under the home directory of @code{alice}. Any
modification made by Alice to the brushes or stamps will not propagate
back to the store (which is read-only anyway).
@lisp
(operating-system
;; @dots{}
(services
(cons*
(service vfs-mapping-service-type
(vfs-mapping-configuration
(bindings (list (vfs-mapping
(source #~(string-append #$tuxpaint
"/share/tuxpaint"))
(destination "/home/alice/.tuxpaint")
(user "alice")
(policy 'overlay)
(name "alice-tuxpaint-overlay"))))))
%desktop-services)))
@end lisp
The service can also be extended by providing a list of
@code{vfs-mapping}, allowing for easier splitting of configuration.
@lisp
(operating-system
;; @dots{}
(services
(cons*
(simple-service 'bob-too-wants-to-hack-on-tuxpaint
vfs-mapping-service-type
(list (vfs-mapping
(source #~(string-append #$tuxpaint "/share/tuxpaint"))
(destination "/home/bob/.tuxpaint")
(user "bob")
(policy 'overlay)
(name "bob-tuxpaint-overlay"))))
%desktop-services)))
@end lisp
The @code{source} file name must exist for the service to start. The
@code{destination} directory will be created if it does not exist.
@defvar vfs-mapping-service-type
Service type for binding a directory in multiple places on the file
system.
The access rights are either the same in source and destination
(@code{'bind}), or writes are translated back to the sources as if made
by the destination's owner (@code{'translate}), or kept in an overlay
directory near the destination (@code{'overlay}). The service's value
must be a @code{vfs-mapping-configuration} object.
@end defvar
@deftp {Data Type} vfs-mapping-configuration
Data type representing the configuration of the vfs-mapping service.
@table @asis
@item @code{bindfs} (default: @code{#~(string-append #$bindfs "/bin/bindfs")})
The @command{bindfs} command to use for mounting.
@item @code{fusermount} (default: @code{#~(string-append #$fuse-2 "/bin/fusermount")})
The @command{fusermount} command to use.
@item @code{umount} (default: @code{#~(string-append #$util-linux+udev "/bin/umount")})
The @command{umount} command to use.
@item @code{bindings} (default: @code{'()})
A list of @code{vfs-mapping} records.
@end table
@end deftp
@deftp {Data Type} vfs-mapping
Data type representing the configuration for a single shared directory.
@table @asis
@item @code{source}
The source file name to be shared.
@item @code{destination}
The destination at which the contents of @code{source} will be exposed.
@item @code{policy} (default: @code{'translate})
Either @code{'bind} (same ownership and access rights for @code{source}
and @code{destination}), @code{'translate} (read-write, with writes
translated as if made by @code{source}'s owner), or @code{'overlay}
(read-only with @code{user}-owned writable overlay).
@item @code{user} (default: @code{#f})
The user that will own the @code{destination} directory, and appear to
own its content. It must be kept at its default @code{#f} value when
using the @code{'bind} policy.
@item @code{group} (default: @code{"users"})
The group that will own the @code{destination} directory, and appear to
own its content.
@item @code{name} (default: @code{"<src>-[<policy>]-><dst>"})
The name of the shepherd service to mount and unmount the binding.
@item @code{requirement} (default: @code{'(file-systems user-homes)})
The list of services that Shepherd ought to provision before trying to
mount.
@end table
@end deftp
@cindex oom
@cindex out of memory killer
@cindex earlyoom

164
gnu/services/linux.scm
View file

@ -7,6 +7,7 @@
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;; Copyright © 2023 Felix Lechner <felix.lechner@lease-up.com>
;;; Copyright © 2025 Edouard Klein <edk@beaver-labs.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -36,6 +37,7 @@
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu packages linux)
#:use-module (gnu packages file-systems)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@ -101,7 +103,11 @@
zram-device-configuration-compression-algorithm
zram-device-configuration-memory-limit
zram-device-configuration-priority
zram-device-service-type))
zram-device-service-type
vfs-mapping-service-type
vfs-mapping-configuration
vfs-mapping))
;;;
@ -547,7 +553,6 @@ the Linux @code{cachefiles} module.")
;;;
;;; Zram device
;;;
(define-record-type* <zram-device-configuration>
zram-device-configuration make-zram-device-configuration
zram-device-configuration?
@ -628,3 +633,158 @@ placed in a udev rules file."
(service-extension udev-service-type
(compose list zram-device-udev-rule))))
(description "Creates a zram swap device.")))
;;;
;;; VFS Mapping.
;;;
(define-record-type* <vfs-mapping>
vfs-mapping make-vfs-mapping
vfs-mapping?
(source vfs-mapping-source)
(destination vfs-mapping-destination)
(policy vfs-mapping-policy
(default 'translate))
(user vfs-mapping-user
(default #f))
(group vfs-mapping-group
(default "users"))
(name vfs-mapping-name
(default (string-append
(vfs-mapping-source this-record) "-["
(vfs-mapping-policy this-record) "]->"
(vfs-mapping-destination this-record)))
(thunked))
(requirement vfs-mapping-requirement
(default '(file-systems user-homes))))
(define (vfs-mapping-policy? x)
(and (symbol? x)
(or (memq x '(bind translate overlay)))))
(define (path-like? x)
(or (string? x)
(file-like? x)
(gexp? x)))
(define (valid-vfs-mapping? x)
;; User must be set iff we are going to use it
(and (vfs-mapping? x)
(path-like? (vfs-mapping-source x))
(path-like? (vfs-mapping-destination x))
(string? (vfs-mapping-name x))
(vfs-mapping-policy? (vfs-mapping-policy x))
(cond
((eq? (vfs-mapping-policy x) 'bind)
(not (vfs-mapping-user x)))
(#t
(and (string? (vfs-mapping-user x))
(string? (vfs-mapping-group x)))))))
(define list-of-vfs-mapping? (list-of valid-vfs-mapping?))
(define-configuration/no-serialization vfs-mapping-configuration
(bindfs (gexp #~(string-append #$bindfs "/bin/bindfs"))
"The bindfs command to use.")
(fusermount (gexp #~(string-append #$fuse-2 "/bin/fusermount"))
"The fusermount command to use.")
(umount (gexp #~(string-append #$util-linux+udev "/bin/umount"))
"The umount command to use.")
(bindings (list-of-vfs-mapping '())
"The list of bindings to mount"))
(define vfs-mapping-shepherd-services
(match-record-lambda <vfs-mapping-configuration>
(fusermount bindfs umount bindings)
(map
(match-record-lambda <vfs-mapping>
(source destination policy user group name requirement)
(shepherd-service
;; Each binding has its own service
(provision (list (string->symbol name)))
;; Make sure the homes are already present
(requirement requirement)
(stop
#~(lambda args
(match (quote #$policy)
('bind (invoke #$umount #$destination))
('translate (invoke #$fusermount "-u" #$destination))
('overlay (begin
;; First the bindfs
(invoke #$fusermount "-u" #$destination)
;; then the overlay
(invoke #$umount #$destination))))
#f))
(start
#~(lambda args
(define (mkdir-recursively dir user group)
;; Like mkdir-p, but chown all created directories to the
;; specified user.
(unless (eq? dir "/")
(when (not (file-exists? dir))
(mkdir-recursively (dirname dir) user group)
(mkdir dir)
(let* ((pw (getpw user))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))
(chown dir uid gid)))))
(mkdir-recursively #$destination #$user #$group)
(let* ((stat (stat #$source))
(uid (stat:uid stat))
(gid (stat:gid stat))
(source-user (passwd:name (getpwuid uid)))
(source-group (group:name (getgrgid gid))))
(match (quote #$policy)
('bind
(mount #$source #$destination
#f ;type
MS_BIND)) ;flags (bind mount)
('translate
(invoke
#$bindfs
(string-append "--create-for-group=" source-group)
(string-append "--create-for-user=" source-user)
(string-append "--force-user=" #$user)
(string-append "--force-group=" #$group)
"-o" "nonempty"
#$source #$destination))
('overlay
(let ((overlay (string-append #$destination "-overlay"))
(workdir (string-append #$destination "-workdir")))
(mkdir-recursively overlay #$user #$group)
(mkdir-recursively workdir #$user #$group)
(mount "overlay" ;source
#$destination
"overlay" ;type
0 ;flags
(string-append ;options
"lowerdir=" #$source ","
"upperdir=" overlay ","
"workdir=" workdir))
;; Remount the target over itself to make it appear as if
;; owned by user-name and user-group.
(invoke
#$bindfs
(string-append "--create-for-group=" source-group)
(string-append "--create-for-user=" source-user)
(string-append "--force-user=" #$user)
(string-append "--force-group=" #$group)
#$destination #$destination)))))
#t))))
bindings)))
(define vfs-mapping-service-type
(service-type
(name 'vfs-mapping)
(extensions (list
(service-extension shepherd-root-service-type
vfs-mapping-shepherd-services)))
(compose concatenate)
(extend (lambda (original extensions)
(vfs-mapping-configuration
(inherit original)
(bindings (append (vfs-mapping-configuration-bindings original)
extensions)))))
(default-value (vfs-mapping-configuration))
(description "Share or expose a file name under a different name.")))