services: Add shared-cache-service-type.

* gnu/services/guix.scm (shared-cache-service-type)
(shared-cache-configuration, user-cache): New variables.
* doc/guix.texi (Shared Cache Service): New subsubsection under
"Guix Services".

Change-Id: I73a8db228d9a892c8bb93c6cdfef12d0d06e25a6
Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
Modified-by: Maxim Cournoyer <maxim@guixotic.coop>

2 files changed, 216 insertions, 1 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 98b388886b..10cd50b5fa 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42891,6 +42891,136 @@ File name of the file system key for the target volume.
 @node Guix Services
 @subsection Guix Services
 
+@subsubheading Shared Cache Service
+@cindex shared cache
+@cindex cache, sharing
+
+Running @command{guix pull}, @command{guix time-machine}, @command{guix
+system reconfigure}, and @command{guix home reconfigure} pulls the
+complete Git version control history of your channels in
+@file{$HOME/.cache/guix/checkouts}.  If you have multiple user accounts
+(typically @code{root} and a main user account for your personal
+computer), or if multiple users are using the system (typically on a
+shared server), then this can quickly waste a lot of space.
+
+The @code{shared-cache} service lets you prevent this waste by
+either sharing or exposing a specific user's cache to the other users.
+
+In the context of this service, @emph{sharing} and @emph{exposing} have
+the same meaning as with @command{guix shell}: making the shared cache
+directory read-only if you use mode @option{'expose} (the default), and
+writable if you use mode @option{'share}, (@pxref{Invoking
+guix shell, @option{--expose} and @option{--share}}).
+
+Whatever mode you choose, from the point of view of the user, the cache
+appears writable.  With @option{'expose}, any write will be stored in a
+user-owned overlay directory next to mountpoint, whereas with
+@option{'share}, writes will be propagated back to the sharing user's
+cache.
+
+@quotation Warning
+Use the @option{'share} option @emph{if and only if} users on the
+machine trust each other.  This is a hard requirement since, with this
+option, any user could ``poison'' the shared cache to indirectly gain
+access to other user's data and privileges.
+@end quotation
+
+@quotation Warning
+Using @option{'share} is meant for a single-seat computer where the
+single user has unprivileged user accounts---e.g. one for work and one
+for gaming.  Even then, channels from one will leak into the other's
+cache.  Use with caution.
+@end quotation
+
+@quotation Warning
+@option{'share} will not work for multiple concurrent invokation of
+@command{guix}, e.g. if two user accounts run @command{guix time
+machine} at the same time, the results will be fun but not useful.
+@end quotation
+
+Here is an example configuration that exposes @code{root}'s guix
+checkout cache to @code{alice} and @code{bob}:
+
+@lisp
+(operating-system
+  ;; @dots{}
+     (services
+      (cons*
+       (service shared-cache-service-type
+             (shared-cache-configuration
+               (users (list (user-cache (user "alice"))
+                            (user-cache (user "bob"))))))
+                    %desktop-services)))
+@end lisp
+
+The service can also be extended by providing a list of
+@code{user-cache}, allowing for easier splitting of configuration.
+
+@lisp
+(operating-system
+  ;; @dots{}
+  (services
+   (cons*
+    (simple-service 'bob-shared-guix-cache shared-cache-service-type
+                    (list (user-cache (user "bob"))))
+    %desktop-services)))
+@end lisp
+
+@defvar shared-cache-service-type
+Service type for sharing a subdirectory of @file{~/.cache/} between
+multiple users.
+
+This service allows different system users to share the contents of the
+user cache, avoiding duplication and saving disk space.  It can be
+configured in either ``share'' mode, where all users write to the same
+cache, or ``expose'' mode, where users get a read-only view with a
+writable overlay.  Its value must be a @code{shared-cache-configuration}
+object.
+@end defvar
+
+@deftp {Data Type} shared-cache-configuration
+Data type representing the configuration of the shared cache.
+
+@table @asis
+@item @code{mode} (default: @code{'expose})
+Either @code{'share} (read-write, dangerous) or @code{'expose}
+(read-only with per-user overlay, the default).  In share mode, all
+writes go to the shared directory.  In expose mode, only reads use the
+shared directory; writes go to a user-owned overlay.
+
+@item @code{shared-directory} (default: @code{"/root/.cache"})
+The source cache directory that is shared between users.  Each user will
+see some or all of its subdirectories mounted into their own
+@file{~/.cache}.
+
+@item @code{users} (default: @code{'()})
+The list of users that will benefit from the shared directory.  This
+must be a list of @code{user-info} records.
+
+@end table
+@end deftp
+
+@deftp {Data Type} user-info
+Data type representing the configuration for a single user benefitting
+from a shared cache.
+
+@table @asis
+@item @code{user}
+The username of the user.
+
+@item @code{location} (default: @code{"/home/@var{user}/.cache"})
+The cache directory of the user.
+
+@item @code{group} (default: @code{"users"})
+The primary group of the user.
+
+@item @code{directories} (default: @code{'("guix/checkouts")})
+List of subdirectories of the @code{shared-cache-configuration}'s
+@code{shared-directory} (whose default is @file{/root/.cache}) to mount
+under @var{location} (whose default is @file{~/.cache/}) for the user.
+@end table
+@end deftp
+
 @subsubheading Build Farm Front-End (BFFE)
 The @uref{https://git.cbaines.net/guix/bffe/,Build Farm Front-End}
 assists with building Guix packages in bulk.  It's responsible for
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 8f6b6652ef..cb8f6ef4f7 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -1,6 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2024 Andrew Tropin <andrew@trop.in>
+;;; Copyright © 2025 Edouard Klein <edk@beaver-labs.com>
+;;; Copyright © 2025 Rutherther <rutherther@digital.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,11 +33,15 @@
   #:use-module (gnu packages guile)
   #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages file-systems)
+  #:use-module (gnu packages linux)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services admin)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services getmail)
+  #:use-module (gnu services linux)
   #:use-module (gnu system shadow)
   #:export (guix-build-coordinator-configuration
             guix-build-coordinator-configuration?
@@ -145,7 +151,11 @@
             bffe-configuration-arguments
             bffe-configuration-extra-environment-variables
 
-            bffe-service-type))
+            bffe-service-type
+
+            shared-cache-service-type
+            shared-cache-configuration
+            user-cache))
 
 ;;;; Commentary:
 ;;;
@@ -1181,3 +1191,78 @@ ca-certificates.crt file in the system profile."
                              bffe-account)))
    (description
     "Run the Build Farm Front-end.")))
+
+;;;
+;;; Share .cache/ content between users
+;;;
+;;; On a system with multiple users, each $HOME/.cache/guix is
+;;; ~700MB of data that is mostly the same between users.  This service allows
+;;; one to either:
+;;
+;;; - share this cache between users, with updates shared between users, which
+;;; is suitable for a high trust environment, typically a single human user
+;;; with multiple accounts on the same computer
+;;;
+;;; - or expose a single user's cache, read-only with a write overlay, to the
+;;; other users, typically used in low-trust environments such as a public
+;;; access guix system.
+
+(define-record-type* <user-cache>
+  user-cache make-user-cache
+  user-cache?
+  (user        user-cache-user)
+  (location    user-cache-location    (default (string-append "/home/" (user-cache-user this-record) "/.cache")) (thunked))
+  (group       user-cache-group       (default "users"))
+  (directories user-cache-directories (default '("guix/checkouts"))))
+
+(define list-of-user-cache? (list-of user-cache?))
+
+(define (mount-type? x)
+  (and (symbol? x)
+       (or (eq? x 'share)
+           (eq? x 'expose))))
+
+(define-configuration/no-serialization shared-cache-configuration
+  (mode             (mount-type         'expose)             "Either 'share (read-write, dangerous) or 'expose (read-only, the default) the cache directory.")
+  (shared-directory (string             "/root/.cache")      "The sharing user's cache directory (i.e. the source).")
+  (users            (list-of-user-cache '())                 "The users that benefit from the shared directory. This is a list of user-cache records (i.e. the destinations)."))
+
+(define shared-cache-vfs-mappings
+  (match-record-lambda <shared-cache-configuration>
+      (mode shared-directory users)
+    (apply
+     append
+     (map
+      (match-record-lambda <user-cache>
+          (location user group directories)
+        (map
+         (lambda (subdir)
+           (vfs-mapping
+            ;; Each subdir has its own service
+            (name (string-append "shared-cache-" subdir "-" user))
+            ;; Make sure the homes are already present
+            (requirement '(file-systems user-homes))
+            ;; Mount each shared dir over the target dir in the users' .cache/
+            (source      (string-append shared-directory "/" subdir))
+            (destination (string-append location         "/" subdir))
+            (policy      (match mode
+                           ('expose 'overlay)
+                           ('share  'translate)))
+            (user        user)
+            (group       group)))
+           directories))
+      users))))
+
+(define shared-cache-service-type
+  (service-type
+   (name 'shared-cache)
+   (extensions (list
+                (service-extension vfs-mapping-service-type
+                                   shared-cache-vfs-mappings)))
+   (compose concatenate)
+   (extend (lambda (original extensions)
+             (shared-cache-configuration
+              (inherit original)
+              (users (append (shared-cache-configuration-users original) extensions)))))
+   (default-value (shared-cache-configuration))
+   (description "Share or expose ~/.cache/ sub directories between multiple users.")))