Commit | Line | Data |
---|---|---|
ec600e45 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (test-accounts) | |
20 | #:use-module (gnu build accounts) | |
21 | #:use-module (gnu system accounts) | |
22 | #:use-module (srfi srfi-19) | |
23 | #:use-module (srfi srfi-64) | |
24 | #:use-module (ice-9 vlist) | |
25 | #:use-module (ice-9 match)) | |
26 | ||
27 | (define %passwd-sample | |
28 | "\ | |
29 | root:x:0:0:Admin:/root:/bin/sh | |
30 | charlie:x:1000:998:Charlie:/home/charlie:/bin/sh\n") | |
31 | ||
32 | (define %group-sample | |
33 | "\ | |
34 | root:x:0: | |
35 | wheel:x:999:alice,bob | |
36 | hackers:x:65000:alice,charlie\n") | |
37 | ||
38 | (define %shadow-sample | |
39 | (string-append "\ | |
40 | root:" (crypt "secret" "$6$abc") ":17169:::::: | |
41 | charlie:" (crypt "hey!" "$6$abc") ":17169:::::: | |
42 | nobody:!:0::::::\n")) | |
43 | ||
44 | \f | |
45 | (test-begin "accounts") | |
46 | ||
47 | (test-equal "write-passwd" | |
48 | %passwd-sample | |
49 | (call-with-output-string | |
50 | (lambda (port) | |
51 | (write-passwd (list (password-entry | |
52 | (name "root") | |
53 | (uid 0) (gid 0) | |
54 | (real-name "Admin") | |
55 | (directory "/root") | |
56 | (shell "/bin/sh")) | |
57 | (password-entry | |
58 | (name "charlie") | |
59 | (uid 1000) (gid 998) | |
60 | (real-name "Charlie") | |
61 | (directory "/home/charlie") | |
62 | (shell "/bin/sh"))) | |
63 | port)))) | |
64 | ||
dd4e46ed LC |
65 | (test-equal "write-passwd with duplicate entry" |
66 | %passwd-sample | |
67 | (call-with-output-string | |
68 | (lambda (port) | |
69 | (let ((charlie (password-entry | |
70 | (name "charlie") | |
71 | (uid 1000) (gid 998) | |
72 | (real-name "Charlie") | |
73 | (directory "/home/charlie") | |
74 | (shell "/bin/sh")))) | |
75 | (write-passwd (list (password-entry | |
76 | (name "root") | |
77 | (uid 0) (gid 0) | |
78 | (real-name "Admin") | |
79 | (directory "/root") | |
80 | (shell "/bin/sh")) | |
81 | charlie charlie) | |
82 | port))))) | |
83 | ||
ec600e45 LC |
84 | (test-equal "read-passwd + write-passwd" |
85 | %passwd-sample | |
86 | (call-with-output-string | |
87 | (lambda (port) | |
88 | (write-passwd (call-with-input-string %passwd-sample | |
89 | read-passwd) | |
90 | port)))) | |
91 | ||
92 | (test-equal "write-group" | |
93 | %group-sample | |
94 | (call-with-output-string | |
95 | (lambda (port) | |
96 | (write-group (list (group-entry | |
97 | (name "root") (gid 0)) | |
98 | (group-entry | |
99 | (name "wheel") (gid 999) | |
100 | (members '("alice" "bob"))) | |
101 | (group-entry | |
102 | (name "hackers") (gid 65000) | |
103 | (members '("alice" "charlie")))) | |
104 | port)))) | |
105 | ||
106 | (test-equal "read-group + write-group" | |
107 | %group-sample | |
108 | (call-with-output-string | |
109 | (lambda (port) | |
110 | (write-group (call-with-input-string %group-sample | |
111 | read-group) | |
112 | port)))) | |
113 | ||
114 | (test-equal "write-shadow" | |
115 | %shadow-sample | |
116 | (call-with-output-string | |
117 | (lambda (port) | |
118 | (write-shadow (list (shadow-entry | |
119 | (name "root") | |
120 | (password (crypt "secret" "$6$abc")) | |
121 | (last-change 17169)) | |
122 | (shadow-entry | |
123 | (name "charlie") | |
124 | (password (crypt "hey!" "$6$abc")) | |
125 | (last-change 17169)) | |
126 | (shadow-entry | |
127 | (name "nobody"))) | |
128 | port)))) | |
129 | ||
130 | (test-equal "read-shadow + write-shadow" | |
131 | %shadow-sample | |
132 | (call-with-output-string | |
133 | (lambda (port) | |
134 | (write-shadow (call-with-input-string %shadow-sample | |
135 | read-shadow) | |
136 | port)))) | |
137 | ||
138 | \f | |
139 | (define allocate-groups (@@ (gnu build accounts) allocate-groups)) | |
140 | (define allocate-passwd (@@ (gnu build accounts) allocate-passwd)) | |
141 | ||
142 | (test-equal "allocate-groups" | |
143 | ;; Allocate GIDs in a stateless fashion. | |
144 | (list (group-entry (name "s") (gid %system-id-max)) | |
145 | (group-entry (name "x") (gid 900)) | |
146 | (group-entry (name "t") (gid 899)) | |
147 | (group-entry (name "a") (gid %id-min) (password "foo") | |
148 | (members '("alice" "bob"))) | |
149 | (group-entry (name "b") (gid (+ %id-min 1)) | |
150 | (members '("charlie")))) | |
151 | (allocate-groups (list (user-group (name "s") (system? #t)) | |
152 | (user-group (name "x") (id 900)) | |
153 | (user-group (name "t") (system? #t)) | |
154 | (user-group (name "a") (password "foo")) | |
155 | (user-group (name "b"))) | |
156 | (alist->vhash `(("a" . "bob") | |
157 | ("a" . "alice") | |
158 | ("b" . "charlie"))))) | |
159 | ||
160 | (test-equal "allocate-groups with requested GIDs" | |
161 | ;; Make sure the requested GID for "b" is honored. | |
162 | (list (group-entry (name "a") (gid (+ 1 %id-min))) | |
163 | (group-entry (name "b") (gid %id-min)) | |
164 | (group-entry (name "c") (gid (+ 2 %id-min)))) | |
165 | (allocate-groups (list (user-group (name "a")) | |
166 | (user-group (name "b") (id %id-min)) | |
167 | (user-group (name "c"))) | |
168 | vlist-null)) | |
169 | ||
170 | (test-equal "allocate-groups with previous state" | |
171 | ;; Make sure bits of state are preserved: password, GID, no reuse of | |
172 | ;; previously-used GIDs. | |
173 | (list (group-entry (name "s") (gid (- %system-id-max 1))) | |
174 | (group-entry (name "t") (gid (- %system-id-max 2))) | |
175 | (group-entry (name "a") (gid 30000) (password #f) | |
176 | (members '("alice" "bob"))) | |
177 | (group-entry (name "b") (gid 30001) (password "bar") | |
178 | (members '("charlie")))) | |
179 | (allocate-groups (list (user-group (name "s") (system? #t)) | |
180 | (user-group (name "t") (system? #t)) | |
181 | (user-group (name "a") (password "foo")) | |
182 | (user-group (name "b"))) | |
183 | (alist->vhash `(("a" . "bob") | |
184 | ("a" . "alice") | |
185 | ("b" . "charlie"))) | |
186 | (list (group-entry (name "a") (gid 30000)) | |
187 | (group-entry (name "b") (gid 30001) | |
188 | (password "bar")) | |
189 | (group-entry (name "removed") | |
190 | (gid %system-id-max))))) | |
191 | ||
192 | (test-equal "allocate-groups with previous state, looping" | |
193 | ;; Check that allocation starts after the highest previously-used GID, and | |
194 | ;; loops back to the lowest GID. | |
195 | (list (group-entry (name "a") (gid (- %id-max 1))) | |
196 | (group-entry (name "b") (gid %id-min)) | |
197 | (group-entry (name "c") (gid (+ 1 %id-min)))) | |
198 | (allocate-groups (list (user-group (name "a")) | |
199 | (user-group (name "b")) | |
200 | (user-group (name "c"))) | |
201 | vlist-null | |
202 | (list (group-entry (name "d") | |
203 | (gid (- %id-max 2)))))) | |
204 | ||
205 | (test-equal "allocate-passwd" | |
206 | ;; Allocate UIDs in a stateless fashion. | |
207 | (list (password-entry (name "alice") (uid %id-min) (gid 1000) | |
208 | (real-name "Alice") (shell "/bin/sh") | |
209 | (directory "/home/alice")) | |
210 | (password-entry (name "bob") (uid (+ 1 %id-min)) (gid 1001) | |
211 | (real-name "Bob") (shell "/bin/gash") | |
212 | (directory "/home/bob")) | |
213 | (password-entry (name "sshd") (uid %system-id-max) (gid 500) | |
214 | (real-name "sshd") (shell "/nologin") | |
215 | (directory "/var/empty")) | |
216 | (password-entry (name "guix") (uid 30000) (gid 499) | |
217 | (real-name "Guix") (shell "/nologin") | |
218 | (directory "/var/empty"))) | |
219 | (allocate-passwd (list (user-account (name "alice") | |
220 | (comment "Alice") | |
ec600e45 LC |
221 | (shell "/bin/sh") |
222 | (group "users")) | |
223 | (user-account (name "bob") | |
224 | (comment "Bob") | |
ec600e45 LC |
225 | (shell "/bin/gash") |
226 | (group "wheel")) | |
227 | (user-account (name "sshd") (system? #t) | |
228 | (comment "sshd") | |
229 | (home-directory "/var/empty") | |
230 | (shell "/nologin") | |
231 | (group "sshd")) | |
232 | (user-account (name "guix") (system? #t) | |
233 | (comment "Guix") | |
234 | (home-directory "/var/empty") | |
235 | (shell "/nologin") | |
236 | (group "guix") | |
237 | (uid 30000))) | |
238 | (list (group-entry (name "users") (gid 1000)) | |
239 | (group-entry (name "wheel") (gid 1001)) | |
240 | (group-entry (name "sshd") (gid 500)) | |
241 | (group-entry (name "guix") (gid 499))))) | |
242 | ||
243 | (test-equal "allocate-passwd with previous state" | |
244 | ;; Make sure bits of state are preserved: UID, no reuse of previously-used | |
245 | ;; UIDs, and shell. | |
246 | (list (password-entry (name "alice") (uid 1234) (gid 1000) | |
0c329bf4 | 247 | (real-name "Alice Smith") (shell "/bin/sh") |
ec600e45 LC |
248 | (directory "/home/alice")) |
249 | (password-entry (name "charlie") (uid 1236) (gid 1000) | |
250 | (real-name "Charlie") (shell "/bin/sh") | |
251 | (directory "/home/charlie"))) | |
252 | (allocate-passwd (list (user-account (name "alice") | |
253 | (comment "Alice") | |
0c329bf4 | 254 | (shell "/bin/sh") ;honored |
ec600e45 LC |
255 | (group "users")) |
256 | (user-account (name "charlie") | |
257 | (comment "Charlie") | |
ec600e45 LC |
258 | (shell "/bin/sh") |
259 | (group "users"))) | |
260 | (list (group-entry (name "users") (gid 1000))) | |
261 | (list (password-entry (name "alice") (uid 1234) (gid 9999) | |
262 | (real-name "Alice Smith") | |
0c329bf4 | 263 | (shell "/gnu/.../bin/gash") ;ignored |
ec600e45 LC |
264 | (directory "/home/alice")) |
265 | (password-entry (name "bob") (uid 1235) (gid 1001) | |
266 | (real-name "Bob") (shell "/bin/sh") | |
267 | (directory "/home/bob"))))) | |
268 | ||
269 | (test-equal "user+group-databases" | |
270 | ;; The whole shebang. | |
271 | (list (list (group-entry (name "a") (gid %id-min) | |
272 | (members '("bob"))) | |
273 | (group-entry (name "b") (gid (+ 1 %id-min)) | |
274 | (members '("alice"))) | |
275 | (group-entry (name "s") (gid %system-id-max))) | |
276 | (list (password-entry (name "alice") (real-name "Alice") | |
277 | (uid %id-min) (gid %id-min) | |
278 | (directory "/a")) | |
279 | (password-entry (name "bob") (real-name "Bob") | |
280 | (uid (+ 1 %id-min)) (gid (+ 1 %id-min)) | |
281 | (directory "/b")) | |
282 | (password-entry (name "nobody") | |
283 | (uid 65534) (gid %system-id-max) | |
284 | (directory "/var/empty"))) | |
285 | (list (shadow-entry (name "alice") (last-change 100) | |
286 | (password (crypt "initial pass" "$6$"))) | |
287 | (shadow-entry (name "bob") (last-change 50) | |
288 | (password (crypt "foo" "$6$"))) | |
289 | (shadow-entry (name "nobody") (last-change 100)))) | |
290 | (call-with-values | |
291 | (lambda () | |
292 | (user+group-databases (list (user-account | |
293 | (name "alice") | |
294 | (comment "Alice") | |
295 | (home-directory "/a") | |
296 | (group "a") | |
297 | (supplementary-groups '("b")) | |
298 | (password (crypt "initial pass" "$6$"))) | |
299 | (user-account | |
300 | (name "bob") | |
301 | (comment "Bob") | |
302 | (home-directory "/b") | |
303 | (group "b") | |
304 | (supplementary-groups '("a"))) | |
305 | (user-account | |
306 | (name "nobody") | |
307 | (group "s") | |
308 | (uid 65534) | |
309 | (home-directory "/var/empty"))) | |
310 | (list (user-group (name "a")) | |
311 | (user-group (name "b")) | |
312 | (user-group (name "s") (system? #t))) | |
313 | #:current-passwd '() | |
314 | #:current-shadow | |
315 | (list (shadow-entry (name "bob") | |
316 | (password (crypt "foo" "$6$")) | |
317 | (last-change 50))) | |
318 | #:current-groups '() | |
319 | #:current-time | |
320 | (lambda (type) | |
321 | (make-time type 0 (* 24 3600 100))))) | |
322 | list)) | |
323 | ||
324 | (test-end "accounts") |