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