Commit | Line | Data |
---|---|---|
0ded70f3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
b0de7fdb | 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> |
ba2613bb | 3 | ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> |
0ded70f3 LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu system shadow) | |
bacadb02 | 21 | #:use-module (guix records) |
b5f4e686 | 22 | #:use-module (guix gexp) |
e87f0591 | 23 | #:use-module (guix store) |
ae763b5b | 24 | #:use-module (guix modules) |
0c09a306 LC |
25 | #:use-module (guix sets) |
26 | #:use-module (guix ui) | |
0adfe95a | 27 | #:use-module (gnu services) |
ae763b5b | 28 | #:use-module (gnu services shepherd) |
7f239fd3 LC |
29 | #:use-module ((gnu system file-systems) |
30 | #:select (%tty-gid)) | |
9de46ffb | 31 | #:use-module ((gnu packages admin) |
d0c66871 | 32 | #:select (shadow)) |
78ed0038 | 33 | #:use-module (gnu packages bash) |
838d9a9d | 34 | #:use-module (gnu packages guile-wm) |
0adfe95a | 35 | #:use-module (srfi srfi-1) |
0c09a306 LC |
36 | #:use-module (srfi srfi-26) |
37 | #:use-module (srfi srfi-34) | |
38 | #:use-module (srfi srfi-35) | |
bacadb02 LC |
39 | #:export (user-account |
40 | user-account? | |
41 | user-account-name | |
ab6a279a | 42 | user-account-password |
bacadb02 | 43 | user-account-uid |
ab6a279a LC |
44 | user-account-group |
45 | user-account-supplementary-groups | |
bacadb02 LC |
46 | user-account-comment |
47 | user-account-home-directory | |
ae763b5b | 48 | user-account-create-home-directory? |
bacadb02 | 49 | user-account-shell |
459dd9ea | 50 | user-account-system? |
bacadb02 | 51 | |
16a0e9dc LC |
52 | user-group |
53 | user-group? | |
54 | user-group-name | |
55 | user-group-password | |
56 | user-group-id | |
c8fa3426 | 57 | user-group-system? |
838d9a9d LC |
58 | |
59 | default-skeletons | |
773e956d | 60 | skeleton-directory |
0c09a306 | 61 | %base-groups |
bf87f38a | 62 | %base-user-accounts |
0adfe95a LC |
63 | |
64 | account-service-type | |
65 | account-service)) | |
0ded70f3 LC |
66 | |
67 | ;;; Commentary: | |
68 | ;;; | |
69 | ;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.) | |
70 | ;;; | |
71 | ;;; Code: | |
72 | ||
bacadb02 LC |
73 | (define-record-type* <user-account> |
74 | user-account make-user-account | |
75 | user-account? | |
76 | (name user-account-name) | |
ab6a279a LC |
77 | (password user-account-password (default #f)) |
78 | (uid user-account-uid (default #f)) | |
79 | (group user-account-group) ; number | string | |
80 | (supplementary-groups user-account-supplementary-groups | |
81 | (default '())) ; list of strings | |
bacadb02 LC |
82 | (comment user-account-comment (default "")) |
83 | (home-directory user-account-home-directory) | |
eb56ee02 LC |
84 | (create-home-directory? user-account-create-home-directory? ;Boolean |
85 | (default #t)) | |
b5f4e686 | 86 | (shell user-account-shell ; gexp |
357db1f9 | 87 | (default (file-append bash "/bin/bash"))) |
459dd9ea LC |
88 | (system? user-account-system? ; Boolean |
89 | (default #f))) | |
bacadb02 | 90 | |
16a0e9dc LC |
91 | (define-record-type* <user-group> |
92 | user-group make-user-group | |
93 | user-group? | |
94 | (name user-group-name) | |
95 | (password user-group-password (default #f)) | |
c8fa3426 LC |
96 | (id user-group-id (default #f)) |
97 | (system? user-group-system? ; Boolean | |
98 | (default #f))) | |
16a0e9dc | 99 | |
0adfe95a | 100 | |
773e956d LC |
101 | (define %base-groups |
102 | ;; Default set of groups. | |
c8fa3426 LC |
103 | (let-syntax ((system-group (syntax-rules () |
104 | ((_ args ...) | |
105 | (user-group (system? #t) args ...))))) | |
106 | (list (system-group (name "root") (id 0)) | |
0adfe95a LC |
107 | (system-group (name "wheel")) ; root-like users |
108 | (system-group (name "users")) ; normal users | |
109 | (system-group (name "nogroup")) ; for daemons etc. | |
773e956d | 110 | |
c8fa3426 LC |
111 | ;; The following groups are conventionally used by things like udev to |
112 | ;; control access to hardware devices. | |
113 | (system-group (name "tty") (id %tty-gid)) | |
114 | (system-group (name "dialout")) | |
115 | (system-group (name "kmem")) | |
0adfe95a | 116 | (system-group (name "input")) ; input devices, from udev |
c8fa3426 LC |
117 | (system-group (name "video")) |
118 | (system-group (name "audio")) | |
0adfe95a | 119 | (system-group (name "netdev")) ; used in avahi-dbus.conf |
c8fa3426 LC |
120 | (system-group (name "lp")) |
121 | (system-group (name "disk")) | |
122 | (system-group (name "floppy")) | |
123 | (system-group (name "cdrom")) | |
7f28bf9a | 124 | (system-group (name "tape")) |
0adfe95a | 125 | (system-group (name "kvm"))))) ; for /dev/kvm |
773e956d | 126 | |
bf87f38a LC |
127 | (define %base-user-accounts |
128 | ;; List of standard user accounts. Note that "root" is a special case, so | |
129 | ;; it's not listed here. | |
130 | (list (user-account | |
131 | (name "nobody") | |
132 | (uid 65534) | |
133 | (group "nogroup") | |
357db1f9 | 134 | (shell (file-append shadow "/sbin/nologin")) |
2d94702f | 135 | (home-directory "/nonexistent") |
d03db743 | 136 | (create-home-directory? #f) |
bf87f38a LC |
137 | (system? #t)))) |
138 | ||
838d9a9d LC |
139 | (define (default-skeletons) |
140 | "Return the default skeleton files for /etc/skel. These files are copied by | |
141 | 'useradd' in the home directory of newly created user accounts." | |
142 | (define copy-guile-wm | |
4ee96a79 LC |
143 | (with-imported-modules '((guix build utils)) |
144 | #~(begin | |
145 | (use-modules (guix build utils)) | |
4ddb64f5 | 146 | (copy-file (car (find-files #+guile-wm "wm-init-sample.scm")) |
4ee96a79 | 147 | #$output)))) |
838d9a9d | 148 | |
e79467f6 | 149 | (let ((profile (plain-file "bash_profile" "\ |
4e2a21d3 SB |
150 | # Honor per-interactive-shell startup file |
151 | if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) | |
e79467f6 | 152 | (bashrc (plain-file "bashrc" "\ |
9a10acc9 LC |
153 | # Bash initialization for interactive non-login shells and |
154 | # for remote shells (info \"(bash) Bash Startup Files\"). | |
155 | ||
2f094a69 LC |
156 | # Export 'SHELL' to child processes. Programs such as 'screen' |
157 | # honor it and otherwise use /bin/sh. | |
158 | export SHELL | |
159 | ||
0ab59dd8 | 160 | if [[ $- != *i* ]] |
9a10acc9 | 161 | then |
0ab59dd8 MB |
162 | # We are being invoked from a non-interactive shell. If this |
163 | # is an SSH session (as in \"ssh host command\"), source | |
164 | # /etc/profile so we get PATH and other essential variables. | |
165 | [[ -n \"$SSH_CLIENT\" ]] && source /etc/profile | |
2c16be56 MB |
166 | |
167 | # Don't do anything else. | |
168 | return | |
9a10acc9 LC |
169 | fi |
170 | ||
b19950a1 LC |
171 | # Source the system-wide file. |
172 | source /etc/bashrc | |
173 | ||
28de8d25 LC |
174 | # Adjust the prompt depending on whether we're in 'guix environment'. |
175 | if [ -n \"$GUIX_ENVIRONMENT\" ] | |
176 | then | |
ba2613bb | 177 | PS1='\\u@\\h \\w [env]\\$ ' |
28de8d25 | 178 | else |
ba2613bb | 179 | PS1='\\u@\\h \\w\\$ ' |
28de8d25 | 180 | fi |
4e2a21d3 | 181 | alias ls='ls -p --color' |
138fe411 LC |
182 | alias ll='ls -l' |
183 | alias grep='grep --color'\n")) | |
e79467f6 | 184 | (zlogin (plain-file "zlogin" "\ |
02f707c5 SB |
185 | # Honor system-wide environment variables |
186 | source /etc/profile\n")) | |
4ee96a79 | 187 | (guile-wm (computed-file "guile-wm" copy-guile-wm)) |
e79467f6 | 188 | (xdefaults (plain-file "Xdefaults" "\ |
838d9a9d LC |
189 | XTerm*utf8: always |
190 | XTerm*metaSendsEscape: true\n")) | |
e79467f6 | 191 | (gdbinit (plain-file "gdbinit" "\ |
838d9a9d | 192 | # Tell GDB where to look for separate debugging files. |
b0de7fdb LC |
193 | set debug-file-directory ~/.guix-profile/lib/debug |
194 | ||
195 | # Authorize extensions found in the store, such as the | |
196 | # pretty-printers of libstdc++. | |
197 | set auto-load safe-path /gnu/store/*/lib\n"))) | |
e79467f6 LC |
198 | `((".bash_profile" ,profile) |
199 | (".bashrc" ,bashrc) | |
200 | (".zlogin" ,zlogin) | |
76a77cca LC |
201 | (".nanorc" ,(plain-file "nanorc" "\ |
202 | # Include all the syntax highlighting modules. | |
203 | include /run/current-system/profile/share/nano/*.nanorc\n")) | |
e79467f6 | 204 | (".Xdefaults" ,xdefaults) |
a84ea219 | 205 | (".guile" ,(plain-file "dot-guile" |
2ba2c98d LC |
206 | "(cond ((false-if-exception (resolve-interface '(ice-9 readline))) |
207 | => | |
208 | (lambda (module) | |
209 | ;; Enable completion and input history at the REPL. | |
210 | ((module-ref module 'activate-readline)))) | |
211 | (else | |
212 | (display \"Consider installing the 'guile-readline' package for | |
213 | convenient interactive line editing and input history.\\n\\n\")))\n")) | |
e79467f6 LC |
214 | (".guile-wm" ,guile-wm) |
215 | (".gdbinit" ,gdbinit)))) | |
838d9a9d LC |
216 | |
217 | (define (skeleton-directory skeletons) | |
e79467f6 LC |
218 | "Return a directory containing SKELETONS, a list of name/derivation tuples." |
219 | (computed-file "skel" | |
4ee96a79 LC |
220 | (with-imported-modules '((guix build utils)) |
221 | #~(begin | |
222 | (use-modules (ice-9 match) | |
223 | (guix build utils)) | |
224 | ||
225 | (mkdir #$output) | |
226 | (chdir #$output) | |
227 | ||
228 | ;; Note: copy the skeletons instead of symlinking | |
229 | ;; them like 'file-union' does, because 'useradd' | |
230 | ;; would just copy the symlinks as is. | |
231 | (for-each (match-lambda | |
232 | ((target source) | |
233 | (copy-recursively source target))) | |
234 | '#$skeletons) | |
235 | #t)))) | |
838d9a9d | 236 | |
0c09a306 LC |
237 | (define (assert-valid-users/groups users groups) |
238 | "Raise an error if USERS refer to groups not listed in GROUPS." | |
239 | (let ((groups (list->set (map user-group-name groups)))) | |
240 | (define (validate-supplementary-group user group) | |
241 | (unless (set-contains? groups group) | |
242 | (raise (condition | |
243 | (&message | |
244 | (message | |
69daee23 | 245 | (format #f (G_ "supplementary group '~a' \ |
0c09a306 LC |
246 | of user '~a' is undeclared") |
247 | group | |
248 | (user-account-name user)))))))) | |
249 | ||
250 | (for-each (lambda (user) | |
251 | (unless (set-contains? groups (user-account-group user)) | |
252 | (raise (condition | |
253 | (&message | |
254 | (message | |
69daee23 | 255 | (format #f (G_ "primary group '~a' \ |
0c09a306 LC |
256 | of user '~a' is undeclared") |
257 | (user-account-group user) | |
258 | (user-account-name user))))))) | |
259 | ||
260 | (for-each (cut validate-supplementary-group user <>) | |
261 | (user-account-supplementary-groups user))) | |
262 | users))) | |
263 | ||
0adfe95a LC |
264 | \f |
265 | ;;; | |
266 | ;;; Service. | |
267 | ;;; | |
268 | ||
269 | (define (user-group->gexp group) | |
270 | "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for | |
271 | 'active-groups'." | |
272 | #~(list #$(user-group-name group) | |
273 | #$(user-group-password group) | |
274 | #$(user-group-id group) | |
275 | #$(user-group-system? group))) | |
276 | ||
277 | (define (user-account->gexp account) | |
278 | "Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for | |
279 | 'activate-users'." | |
280 | #~`(#$(user-account-name account) | |
281 | #$(user-account-uid account) | |
282 | #$(user-account-group account) | |
283 | #$(user-account-supplementary-groups account) | |
284 | #$(user-account-comment account) | |
285 | #$(user-account-home-directory account) | |
eb56ee02 | 286 | #$(user-account-create-home-directory? account) |
0adfe95a LC |
287 | ,#$(user-account-shell account) ; this one is a gexp |
288 | #$(user-account-password account) | |
289 | #$(user-account-system? account))) | |
290 | ||
291 | (define (account-activation accounts+groups) | |
292 | "Return a gexp that activates ACCOUNTS+GROUPS, a list of <user-account> and | |
293 | <user-group> objects. Raise an error if a user account refers to a undefined | |
294 | group." | |
295 | (define accounts | |
296 | (filter user-account? accounts+groups)) | |
297 | ||
298 | (define user-specs | |
299 | (map user-account->gexp accounts)) | |
300 | ||
301 | (define groups | |
302 | (filter user-group? accounts+groups)) | |
303 | ||
304 | (define group-specs | |
305 | (map user-group->gexp groups)) | |
306 | ||
307 | (assert-valid-users/groups accounts groups) | |
308 | ||
309 | ;; Add users and user groups. | |
310 | #~(begin | |
311 | (setenv "PATH" | |
312 | (string-append #$(@ (gnu packages admin) shadow) "/sbin")) | |
313 | (activate-users+groups (list #$@user-specs) | |
314 | (list #$@group-specs)))) | |
315 | ||
ae763b5b LC |
316 | (define (account-shepherd-service accounts+groups) |
317 | "Return a Shepherd service that creates the home directories for the user | |
318 | accounts among ACCOUNTS+GROUPS." | |
319 | (define accounts | |
320 | (filter user-account? accounts+groups)) | |
321 | ||
322 | ;; Create home directories only once 'file-systems' is up. This makes sure | |
323 | ;; they are created in the right place if /home lives on a separate | |
324 | ;; partition. | |
325 | ;; | |
326 | ;; XXX: We arrange for this service to stop right after it's done its job so | |
327 | ;; that 'guix system reconfigure' knows that it can reload it fearlessly | |
328 | ;; (and thus create new home directories). The cost of this hack is that | |
329 | ;; there's a small window during which first-time logins could happen before | |
330 | ;; the home directory has been created. | |
331 | (list (shepherd-service | |
332 | (requirement '(file-systems)) | |
333 | (provision '(user-homes)) | |
334 | (modules '((gnu build activation))) | |
335 | (start (with-imported-modules (source-module-closure | |
336 | '((gnu build activation))) | |
337 | #~(lambda () | |
338 | (activate-user-home | |
339 | (list #$@(map user-account->gexp accounts))) | |
340 | #f))) ;stop | |
341 | (stop #~(const #f)) | |
342 | (respawn? #f) | |
343 | (documentation "Create user home directories.")))) | |
344 | ||
21059b26 LC |
345 | (define (shells-file shells) |
346 | "Return a file-like object that builds a shell list for use as /etc/shells | |
347 | based on SHELLS. /etc/shells is used by xterm, polkit, and other programs." | |
348 | (computed-file "shells" | |
349 | #~(begin | |
350 | (use-modules (srfi srfi-1)) | |
351 | ||
352 | (define shells | |
353 | (delete-duplicates (list #$@shells))) | |
354 | ||
355 | (call-with-output-file #$output | |
356 | (lambda (port) | |
357 | (display "\ | |
358 | /bin/sh | |
359 | /run/current-system/profile/bin/sh | |
360 | /run/current-system/profile/bin/bash\n" port) | |
361 | (for-each (lambda (shell) | |
362 | (display shell port) | |
363 | (newline port)) | |
364 | shells)))))) | |
365 | (define (etc-files arguments) | |
0adfe95a LC |
366 | "Filter out among ARGUMENTS things corresponding to skeletons, and return |
367 | the /etc/skel directory for those." | |
21059b26 LC |
368 | (let ((skels (filter pair? arguments)) |
369 | (users (filter user-account? arguments))) | |
370 | `(("skel" ,(skeleton-directory skels)) | |
371 | ("shells" ,(shells-file (map user-account-shell users)))))) | |
0adfe95a LC |
372 | |
373 | (define account-service-type | |
374 | (service-type (name 'account) | |
375 | ||
376 | ;; Concatenate <user-account>, <user-group>, and skeleton | |
377 | ;; lists. | |
378 | (compose concatenate) | |
379 | (extend append) | |
380 | ||
381 | (extensions | |
382 | (list (service-extension activation-service-type | |
383 | account-activation) | |
ae763b5b LC |
384 | (service-extension shepherd-root-service-type |
385 | account-shepherd-service) | |
0adfe95a | 386 | (service-extension etc-service-type |
21059b26 | 387 | etc-files))))) |
0adfe95a LC |
388 | |
389 | (define (account-service accounts+groups skeletons) | |
390 | "Return a <service> that takes care of user accounts and user groups, with | |
391 | ACCOUNTS+GROUPS as its initial list of accounts and groups." | |
392 | (service account-service-type | |
393 | (append skeletons accounts+groups))) | |
394 | ||
0ded70f3 | 395 | ;;; shadow.scm ends here |