1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
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.")))