3 files changed, 156 insertions(+), 0 deletions(-)

A modules/ruther/services/bind.scm
A modules/ruther/services/bind.sh
A modules/ruther/services/unbind.sh

@@ 0,0 1,113 @@
+(define-module (ruther services bind)
+  #:use-module (srfi srfi-1)
+  #:use-module (guix records)
+  #:use-module (guix gexp)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu services)
+  #:use-module (gnu packages file-systems)
+  #:use-module (gnu packages linux)
+  #:export (%default-guix-shared-users
+            user-info
+            user-info?
+            user-info-user
+            user-info-home
+
+            guix-shared-cache
+            guix-shared-cache-bindfs
+            guix-shared-cache-main-user
+            guix-shared-cache-shared-directory
+            guix-shared-cache-users
+
+            guix-shared-cache-service-type))
+
+(define-record-type* <user-info>
+  user-info make-user-info
+  user-info?
+  (user user-info-user)
+  (group user-info-group (default "users"))
+  (home user-info-home))
+
+(define (list-of-user-info? lst)
+  (every user-info? lst))
+
+(define %default-guix-shared-users
+  (list
+   (user-info
+    (user "root")
+    (group "root")
+    (home "/root"))))
+
+(define-configuration/no-serialization guix-shared-cache
+  (bindfs (file-like bindfs) "The bindfs package to use.")
+  (fuse (file-like fuse-2) "The fuse package to use")
+
+  (main-user (string "root") "The user that owns the main shared directory")
+  (main-group (string "root") "The group that owns the main shared directory")
+  (shared-directory (string "/shared/guix-cache") "The directory that is shared between users")
+  (users (list-of-user-info %default-guix-shared-users) "The users that have the directory shared"))
+
+(define (shared-guix-cache-shepherd-services config)
+  (map
+   (lambda (user)
+     (let* ((fuse (guix-shared-cache-fuse config))
+            (bindfs (guix-shared-cache-bindfs config))
+            (user-name (user-info-user user))
+            (user-home (user-info-home user))
+            (user-group (user-info-group 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")))
+       (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)
+                  #f))
+        (start #~(lambda args
+                   (define (mkdir-recursively dir user group)
+                     (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 #$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)
+                   #t)))))
+   (guix-shared-cache-users config)))
+
+(define guix-shared-cache-service-type
+  (service-type
+   (name 'shared-guix-cache)
+   (extensions (list
+                (service-extension shepherd-root-service-type
+                                   shared-guix-cache-shepherd-services)))
+   (compose append)
+   (extend (lambda (original extensions)
+             (guix-shared-cache
+              (inherit original)
+              (users (append (guix-shared-cache-users original))))))
+   (default-value (guix-shared-cache))
+   (description "Share ~/.cache/guix between
+multiple users. The root user is going to own the shared checkout,
+and will be part of the users who can use the shared checkout.
+If you want to change the default user, set main-user of the
+configuration. This user owns the shared checkout folder.")))

@@ 0,0 1,24 @@
+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+MAIN=$1
+USER=$2
+GROUP=users
+
+HOME=/home/$USER
+MOUNTDIR=$HOME/.cache/guix
+SHAREDIR=/shared/guix-cache
+
+# for each user
+mkdir -p "$MOUNTDIR"
+mkdir -p "$SHAREDIR"
+chown $USER:$GROUP "$MOUNTDIR"
+
+
+bindfs --create-for-group=$MAIN \
+       --create-for-user=$MAIN \
+       --force-user=$USER \
+       --force-group=$GROUP \
+       "$SHAREDIR" \
+       "$MOUNTDIR"

@@ 0,0 1,19 @@
+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+MAIN=$1
+USER=$2
+GROUP=users
+
+HOME=/home/$USER
+MOUNTDIR=$HOME/.cache/guix
+SHAREDIR=/shared/guix-cache
+
+# for each user
+mkdir -p "$MOUNTDIR"
+mkdir -p "$SHAREDIR"
+chown $USER:$GROUP "$MOUNTDIR"
+chown $USER:$GROUP "$(dirname "$MOUNTDIR")"
+
+fusermount -u "$MOUNTDIR"