1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
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))
27 (define %passwd-sample
29 root:x:0:0:Admin:/root:/bin/sh
30 charlie:x:1000:998:Charlie:/home/charlie:/bin/sh\n")
36 hackers:x:65000:alice,charlie\n")
38 (define %shadow-sample
40 root:" (crypt "secret" "$6$abc") ":17169::::::
41 charlie:" (crypt "hey!" "$6$abc") ":17169::::::
45 (test-begin "accounts")
47 (test-equal "write-passwd"
49 (call-with-output-string
51 (write-passwd (list (password-entry
61 (directory "/home/charlie")
65 (test-equal "write-passwd with duplicate entry"
67 (call-with-output-string
69 (let ((charlie (password-entry
73 (directory "/home/charlie")
75 (write-passwd (list (password-entry
84 (test-equal "read-passwd + write-passwd"
86 (call-with-output-string
88 (write-passwd (call-with-input-string %passwd-sample
92 (test-equal "write-group"
94 (call-with-output-string
96 (write-group (list (group-entry
97 (name "root") (gid 0))
99 (name "wheel") (gid 999)
100 (members '("alice" "bob")))
102 (name "hackers") (gid 65000)
103 (members '("alice" "charlie"))))
106 (test-equal "read-group + write-group"
108 (call-with-output-string
110 (write-group (call-with-input-string %group-sample
114 (test-equal "write-shadow"
116 (call-with-output-string
118 (write-shadow (list (shadow-entry
120 (password (crypt "secret" "$6$abc"))
124 (password (crypt "hey!" "$6$abc"))
130 (test-equal "read-shadow + write-shadow"
132 (call-with-output-string
134 (write-shadow (call-with-input-string %shadow-sample
139 (define allocate-groups (@@ (gnu build accounts) allocate-groups))
140 (define allocate-passwd (@@ (gnu build accounts) allocate-passwd))
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")
158 ("b" . "charlie")))))
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")))
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")
186 (list (group-entry (name "a") (gid 30000))
187 (group-entry (name "b") (gid 30001)
189 (group-entry (name "removed")
190 (gid %system-id-max)))))
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")))
202 (list (group-entry (name "d")
203 (gid (- %id-max 2))))))
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")
223 (user-account (name "bob")
227 (user-account (name "sshd") (system? #t)
229 (home-directory "/var/empty")
232 (user-account (name "guix") (system? #t)
234 (home-directory "/var/empty")
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)))))
243 (test-equal "allocate-passwd with previous state"
244 ;; Make sure bits of state are preserved: UID, no reuse of previously-used
246 (list (password-entry (name "alice") (uid 1234) (gid 1000)
247 (real-name "Alice Smith") (shell "/bin/sh")
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")
254 (shell "/bin/sh") ;honored
256 (user-account (name "charlie")
260 (list (group-entry (name "users") (gid 1000)))
261 (list (password-entry (name "alice") (uid 1234) (gid 9999)
262 (real-name "Alice Smith")
263 (shell "/gnu/.../bin/gash") ;ignored
264 (directory "/home/alice"))
265 (password-entry (name "bob") (uid 1235) (gid 1001)
266 (real-name "Bob") (shell "/bin/sh")
267 (directory "/home/bob")))))
269 (test-equal "user+group-databases"
270 ;; The whole shebang.
271 (list (list (group-entry (name "a") (gid %id-min)
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)
279 (password-entry (name "bob") (real-name "Bob")
280 (uid (+ 1 %id-min)) (gid (+ 1 %id-min))
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))))
292 (user+group-databases (list (user-account
295 (home-directory "/a")
297 (supplementary-groups '("b"))
298 (password (crypt "initial pass" "$6$")))
302 (home-directory "/b")
304 (supplementary-groups '("a")))
309 (home-directory "/var/empty")))
310 (list (user-group (name "a"))
311 (user-group (name "b"))
312 (user-group (name "s") (system? #t)))
315 (list (shadow-entry (name "bob")
316 (password (crypt "foo" "$6$"))
321 (make-time type 0 (* 24 3600 100)))))
324 (test-end "accounts")