From 195c947b33b54c2c0d526be4d24c389aa7322a01 Mon Sep 17 00:00:00 2001
From: Rutherther <rutherther@ditigal.xyz>
Date: Tue, 13 May 2025 21:26:34 +0200
Subject: [PATCH] guix-shared-cache-service-type: share only some of the
 folders

---
 modules/ruther/services/bind.scm | 43 ++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 16 deletions(-)

diff --git a/modules/ruther/services/bind.scm b/modules/ruther/services/bind.scm
index 8cf5299..1bad1fc 100644
--- a/modules/ruther/services/bind.scm
+++ b/modules/ruther/services/bind.scm
@@ -26,7 +26,8 @@
   user-info?
   (user user-info-user)
   (group user-info-group (default "users"))
-  (home user-info-home))
+  (home user-info-home)
+  (files user-info-files (default '("authentication" "checkouts" "http" "inferiors" "locate" "profiles" "substitute"))))
 
 (define (list-of-user-info? lst)
   (every user-info? lst))
@@ -55,19 +56,24 @@
             (user-name (user-info-user user))
             (user-home (user-info-home user))
             (user-group (user-info-group user))
+            (user-files (user-info-files user))
             (main-group (guix-shared-cache-main-group config))
             (main-user (guix-shared-cache-main-user config))
-            (shared-dir (guix-shared-cache-shared-directory config))
-            (mount-dir (string-append user-home "/.cache/guix")))
+            (shared-dir-base (guix-shared-cache-shared-directory config))
+            (mount-dir-base (string-append user-home "/.cache/guix")))
        (shepherd-service
         (provision (list (symbol-append 'shared-guix-cache-
                                         (string->symbol user-name))))
         (requirement '(file-systems user-homes))
         (stop #~(lambda args
-                  (invoke
-                   #$(file-append fuse "/bin/fusermount")
-                   "-u"
-                   #$mount-dir)
+                  (for-each
+                   (lambda (dir)
+                     (let ((mount-dir (string-append #$mount-dir-base "/" dir) ))
+                       (invoke
+                        #$(file-append fuse "/bin/fusermount")
+                        "-u"
+                        mount-dir)))
+                   '#$user-files)
                   #f))
         (start #~(lambda args
                    (define (mkdir-recursively dir user group)
@@ -81,16 +87,21 @@
                                 (gid (passwd:gid pw)))
                            (chown dir uid gid)))))
 
-                   (mkdir-recursively #$shared-dir #$main-user #$main-group)
-                   (mkdir-recursively #$mount-dir #$user-name #$user-group)
 
-                   (invoke
-                    #$(file-append bindfs "/bin/bindfs")
-                    (string-append "--create-for-group=" #$main-group)
-                    (string-append "--create-for-user=" #$main-user)
-                    (string-append "--force-user=" #$user-name)
-                    (string-append "--force-group=" #$user-group)
-                    #$shared-dir #$mount-dir)
+                   (for-each
+                    (lambda (dir)
+                      (let ((mount-dir (string-append #$mount-dir-base "/" dir))
+                            (shared-dir (string-append #$shared-dir-base "/" dir)))
+                        (mkdir-recursively shared-dir #$main-user #$main-group)
+                        (mkdir-recursively mount-dir #$user-name #$user-group)
+                        (invoke
+                         #$(file-append bindfs "/bin/bindfs")
+                         (string-append "--create-for-group=" #$main-group)
+                         (string-append "--create-for-user=" #$main-user)
+                         (string-append "--force-user=" #$user-name)
+                         (string-append "--force-group=" #$user-group)
+                         shared-dir mount-dir)))
+                    '#$user-files)
                    #t)))))
    (guix-shared-cache-users config)))
 
-- 
2.49.0