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
114
115
116
117
118
119
120
121
122
123
124
(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)
(files user-info-files (default '("authentication" "checkouts" "http" "inferiors" "locate" "profiles" "substitute"))))
(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))
(user-files (user-info-files user))
(main-group (guix-shared-cache-main-group config))
(main-user (guix-shared-cache-main-user config))
(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
(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)
(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)))))
(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)))
(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.")))