projects/guix·blob master · refs

772 lines · 27.6 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013-2020, 2022-2023, 2025-2026 Ludovic Courtès <[email protected]>
3;;; Copyright © 2016 Alex Griffin <[email protected]>
4;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
5;;; Copyright © 2020, 2023 Efraim Flashner <[email protected]>
6;;; Copyright © 2020 Maxim Cournoyer <[email protected]>
7;;; Copyright © 2024 Giacomo Leidi <[email protected]>
8;;;
9;;; This file is part of GNU Guix.
10;;;
11;;; GNU Guix is free software; you can redistribute it and/or modify it
12;;; under the terms of the GNU General Public License as published by
13;;; the Free Software Foundation; either version 3 of the License, or (at
14;;; your option) any later version.
15;;;
16;;; GNU Guix is distributed in the hope that it will be useful, but
17;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;;; GNU General Public License for more details.
20;;;
21;;; You should have received a copy of the GNU General Public License
22;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25;;;
26;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
27;;;
28;;; Code:
29
30(define-module (gnu system shadow)
31 #:use-module ((guix diagnostics) #:select (formatted-message))
32 #:use-module (guix records)
33 #:use-module (guix gexp)
34 #:use-module (guix store)
35 #:use-module (guix modules)
36 #:use-module (guix sets)
37 #:use-module (guix ui)
38 #:use-module ((gnu build accounts)
39 #:select (%subordinate-id-count
40 %subordinate-id-max
41 %subordinate-id-min))
42 #:use-module (gnu system accounts)
43 #:use-module (gnu services)
44 #:use-module (gnu services shepherd)
45 #:use-module ((gnu system file-systems)
46 #:select (%tty-gid))
47 #:use-module ((gnu packages admin)
48 #:select (shadow))
49 #:use-module (gnu packages bash)
50 #:use-module (ice-9 match)
51 #:use-module (srfi srfi-1)
52 #:use-module (srfi srfi-26)
53 #:use-module (srfi srfi-34)
54 #:use-module (srfi srfi-35)
55
56 ;; Re-export these bindings for backward compatibility.
57 #:re-export (user-account
58 user-account?
59 user-account-name
60 user-account-password
61 user-account-uid
62 user-account-group
63 user-account-supplementary-groups
64 user-account-comment
65 user-account-home-directory
66 user-account-create-home-directory?
67 user-account-shell
68 user-account-system?
69
70 user-group
71 user-group?
72 user-group-name
73 user-group-password
74 user-group-id
75 user-group-system?)
76
77 #:export (%default-bashrc
78 %default-bash-profile
79 %default-zprofile
80 %default-xdefaults
81 %default-gdbinit
82 %default-nanorc
83 %default-dotguile
84 %default-skeleton-home-config
85 default-skeletons
86 skeleton-directory
87 %base-groups
88 %base-user-accounts
89
90 account-service-type
91 account-service
92
93 subids-configuration
94 subids-configuration?
95 subids-configuration-add-root?
96 subids-configuration-subgids
97 subids-configuration-subuids
98
99 subids-extension
100 subids-extension?
101 subids-extension-subgids
102 subids-extension-subuids
103
104 subids-service-type))
105
106;; Change the default shell used by new <user-account> records.
107(default-shell (file-append bash "/bin/bash"))
108
109(define %base-groups
110 ;; Default set of groups.
111 (let-syntax ((system-group (syntax-rules ()
112 ((_ args ...)
113 (user-group (system? #t) args ...)))))
114 (list (system-group (name "root") (id 0))
115 (system-group (name "wheel")) ; root-like users
116 (system-group (name "users")) ; normal users
117 (system-group (name "nogroup")) ; for daemons etc.
118
119 ;; The following groups are conventionally used by things like udev to
120 ;; control access to hardware devices.
121 (system-group (name "tty") (id %tty-gid))
122 (system-group (name "dialout"))
123 (system-group (name "kmem"))
124 (system-group (name "input")) ; input devices, from udev
125 (system-group (name "video"))
126 (system-group (name "audio"))
127 (system-group (name "netdev")) ; used in avahi-dbus.conf
128 (system-group (name "lp"))
129 (system-group (name "disk"))
130 (system-group (name "floppy"))
131 (system-group (name "cdrom"))
132 (system-group (name "tape"))
133 (system-group (name "kvm")) ; for /dev/kvm
134 (system-group (name "sgx")))))
135
136(define %base-user-accounts
137 ;; List of standard user accounts. Note that "root" is a special case, so
138 ;; it's not listed here.
139 (list (user-account
140 (name "nobody")
141 (uid 65534)
142 (group "nogroup")
143 (shell (file-append shadow "/sbin/nologin"))
144 (home-directory "/nonexistent")
145 (create-home-directory? #f)
146 (system? #t))))
147
148(define %default-bashrc
149 (plain-file "bashrc" "\
150# Bash-specific initialization, including for non-login and remote
151# shells (info \"(bash) Bash Startup Files\").
152
153# Provide a default prompt.
154PS1='\\u@\\h \\w${GUIX_ENVIRONMENT:+ [env]}\\$ '
155
156# Export 'SHELL' to child processes. Programs such as 'screen'
157# honor it and otherwise use /bin/sh.
158export SHELL
159
160if [[ $- != *i* ]]; then
161 # We are being invoked from a non-interactive shell. If this
162 # is an SSH session (as in \"ssh host command\"), source
163 # /etc/profile so we get PATH and other essential variables,
164 # and source one of ~/.bash_profile or ~/.profile for the home
165 # environment.
166
167 if [[ -n \"$SSH_CLIENT\" ]]; then
168 source /etc/profile
169 if [ -f ~/.bash_profile ]; then
170 source ~/.bash_profile
171 elif [ -f ~/.profile ]; then
172 source ~/.profile
173 fi
174 fi
175
176 # Don't do anything else, returning a successful return code.
177 return 0
178fi
179
180for i in /etc/bashrc.d/*.sh; do
181 [[ -r $i ]] && source \"$i\"
182done
183unset i
184
185# Increase the history size (default is 500 entries).
186HISTSIZE=10000
187"))
188
189(define %default-bash-profile
190 (plain-file "bash_profile" "\
191# Honor per-interactive-shell startup file
192if [ -f ~/.bashrc ]; then
193 # Taking care not to source it in the case of a non-interactive SSH
194 # shell, to avoid recursion.
195 [[ $- != *i* && -n $SSH_CLIENT ]] || . ~/.bashrc
196fi
197
198# Merge search-paths from multiple profiles, the order matters.
199eval \"$(guix package --search-paths \\
200-p $HOME/.config/guix/current \\
201-p $HOME/.guix-profile \\
202-p /run/current-system/profile)\"
203
204# Set up Guix Home profile
205if [ -f ~/.profile ]; then . ~/.profile; fi
206
207# Prepend privileged programs.
208export PATH=/run/privileged/bin:$PATH
209"))
210
211(define %default-zprofile
212 (plain-file "zprofile" "\
213# Set up the system, user profile, and related variables.
214emulate sh -c '. /etc/profile'
215# Set up the home environment profile.
216emulate sh -c 'test -f ~/.profile && . ~/.profile'
217"))
218
219(define %default-xdefaults
220 (plain-file "Xdefaults" "\
221XTerm*utf8: always
222XTerm*metaSendsEscape: true\n"))
223
224(define %default-gdbinit
225 (plain-file "gdbinit"
226 "\
227# Record command history.
228set history filename ~/.cache/gdb/history
229set history save on
230set history size 50000
231
232# Tell GDB where to look for separate debugging files.
233guile
234(use-modules (gdb))
235(execute (string-append \"set debug-file-directory \"
236 (string-join
237 (append
238 (if (getenv \"GDB_DEBUG_FILE_DIRECTORY\")
239 (list (getenv \"GDB_DEBUG_FILE_DIRECTORY\"))
240 '())
241 ;; Note: GDB performs tilde expansion.
242 (list \"~/.guix-home/profile/lib/debug\"
243 \"~/.guix-profile/lib/debug\"
244 \"/run/current-system/profile/lib/debug\"))
245 \":\")))
246end
247
248# Authorize extensions found in the store, such as the
249# pretty-printers of libstdc++.
250set auto-load safe-path /gnu/store/*/lib\n"))
251
252(define %default-nanorc
253 (plain-file "nanorc"
254 "# Include all the syntax highlighting modules.
255include /run/current-system/profile/share/nano/*.nanorc\n"))
256
257(define %default-dotguile
258 (plain-file "dot-guile"
259 "(cond ((false-if-exception (resolve-interface '(ice-9 readline)))
260 =>
261 (lambda (module)
262 ;; Enable completion and input history at the REPL.
263 ((module-ref module 'activate-readline))))
264 (else
265 (display \"Consider installing the 'guile-readline' package for
266convenient interactive line editing and input history.\\n\\n\")))
267
268 (unless (getenv \"INSIDE_EMACS\")
269 (cond ((false-if-exception (resolve-interface '(ice-9 colorized)))
270 =>
271 (lambda (module)
272 ;; Enable completion and input history at the REPL.
273 ((module-ref module 'activate-colorized))))
274 (else
275 (display \"Consider installing the 'guile-colorized' package
276for a colorful Guile experience.\\n\\n\"))))\n"))
277
278(define %default-skeleton-home-config
279 (plain-file "default-home-config" "\
280;; This is a sample Guix Home configuration which can help setup your
281;; home directory in the same declarative manner as Guix System.
282;; For more information, see the Home Configuration section of the manual.
283(define-module (guix-home-config)
284 #:use-module (gnu home)
285 #:use-module (gnu home services)
286 #:use-module (gnu home services shells)
287 #:use-module (gnu services)
288 #:use-module (gnu system shadow))
289
290(define home-config
291 (home-environment
292 (services
293 (append
294 (list
295 ;; Uncomment the shell you wish to use for your user:
296 ;(service home-bash-service-type)
297 ;(service home-fish-service-type)
298 ;(service home-zsh-service-type)
299
300 (service home-files-service-type
301 `((\".guile\" ,%default-dotguile)
302 (\".Xdefaults\" ,%default-xdefaults)))
303
304 (service home-xdg-configuration-files-service-type
305 `((\"gdb/gdbinit\" ,%default-gdbinit)
306 (\"nano/nanorc\" ,%default-nanorc))))
307
308 %base-home-services))))
309
310home-config"))
311
312(define gdb-history-placeholder
313 ;; Since GDB will not create ~/.cache/gdb by itself when attempting to save
314 ;; its history file, add a placeholder that ensures this directory exists.
315 (plain-file "gdb-history"
316 "# GDB command history.\n"))
317
318(define (default-skeletons)
319 "Return the default skeleton files for /etc/skel. These files are copied by
320'useradd' in the home directory of newly created user accounts."
321
322 (let ((profile %default-bash-profile)
323 (zprofile %default-zprofile)
324 (xdefaults %default-xdefaults)
325 (gdbinit %default-gdbinit))
326 `((".bash_profile" ,profile)
327 ;; Zsh sources ~/.zprofile before ~/.zshrc, and it sources ~/.zlogin
328 ;; after ~/.zshrc. To avoid interfering with any customizations a user
329 ;; may have made in their ~/.zshrc, put this in .zprofile, not .zlogin.
330 (".zprofile" ,zprofile)
331 (".config/nano/nanorc" ,%default-nanorc)
332 (".Xdefaults" ,xdefaults)
333 (".guile" ,%default-dotguile)
334 (".config/gdb/gdbinit" ,gdbinit)
335 (".cache/gdb/history" ,gdb-history-placeholder)
336 ("guix-home-config.scm" ,%default-skeleton-home-config))))
337
338(define (skeleton-directory skeletons)
339 "Return a directory containing SKELETONS, a list of name/derivation tuples."
340 (computed-file "skel"
341 (with-imported-modules '((guix build utils))
342 #~(begin
343 (use-modules (ice-9 match)
344 (guix build utils))
345
346 (mkdir #$output)
347 (chdir #$output)
348
349 ;; Note: copy the skeletons instead of symlinking
350 ;; them like 'file-union' does, because 'useradd'
351 ;; would just copy the symlinks as is.
352 (for-each (match-lambda
353 ((target source)
354 (mkdir-p (dirname target))
355 (copy-recursively source target)))
356 '#$skeletons)))))
357
358(define (find-duplicates list)
359 "Find duplicate entries in @var{list}.
360Two entries are considered duplicates, if they are @code{equal?} to each other.
361This implementation is made asymptotically faster than @code{delete-duplicates}
362through the internal use of hash tables."
363 (let loop ((list list)
364 ;; We actually modify table in-place, but still allocate it here
365 ;; so that we only need one level of indentation.
366 (table (make-hash-table)))
367 (match list
368 (()
369 (hash-fold (lambda (key value seed)
370 (if (> value 1)
371 (cons key seed)
372 seed))
373 '()
374 table))
375 ((first . rest)
376 (hash-set! table first
377 (1+ (hash-ref table first 0)))
378 (loop rest table)))))
379
380(define (assert-unique-account-names users)
381 (match (find-duplicates (map user-account-name users))
382 (() *unspecified*)
383 (duplicates
384 (warning
385 (G_ "the following accounts appear more than once:~{ ~a~}~%")
386 duplicates))))
387
388(define (assert-unique-group-names groups)
389 (match (find-duplicates (map user-group-name groups))
390 (() *unspecified*)
391 (duplicates
392 (warning
393 (G_ "the following groups appear more than once:~{ ~a~}~%")
394 duplicates))))
395
396(define (assert-valid-users/groups users groups)
397 "Raise an error if USERS refer to groups not listed in GROUPS."
398 (let ((groups (list->set (map user-group-name groups))))
399 (define (validate-supplementary-group user group)
400 (unless (set-contains? groups group)
401 (raise (condition
402 (&message
403 (message
404 (format #f (G_ "supplementary group '~a' \
405of user '~a' is undeclared")
406 group
407 (user-account-name user))))))))
408
409 (for-each (lambda (user)
410 (unless (set-contains? groups (user-account-group user))
411 (raise (condition
412 (&message
413 (message
414 (format #f (G_ "primary group '~a' \
415of user '~a' is undeclared")
416 (user-account-group user)
417 (user-account-name user)))))))
418
419 (for-each (cut validate-supplementary-group user <>)
420 (user-account-supplementary-groups user)))
421 users)))
422
423
424;;;
425;;; Accounts Service.
426;;;
427
428(define (user-group->gexp group)
429 "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for
430'active-groups'."
431 #~(list #$(user-group-name group)
432 #$(user-group-password group)
433 #$(user-group-id group)
434 #$(user-group-system? group)))
435
436(define (user-account->gexp account)
437 "Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for
438'activate-users'."
439 #~`(#$(user-account-name account)
440 #$(user-account-uid account)
441 #$(user-account-group account)
442 #$(user-account-supplementary-groups account)
443 #$(user-account-comment account)
444 #$(user-account-home-directory account)
445 #$(user-account-create-home-directory? account)
446 ,#$(user-account-shell account) ; this one is a gexp
447 #$(user-account-password account)
448 #$(user-account-system? account)))
449
450(define (account-activation accounts+groups)
451 "Return a gexp that activates ACCOUNTS+GROUPS, a list of <user-account> and
452<user-group> objects. Raise an error if a user account refers to a undefined
453group."
454 (define accounts
455 (delete-duplicates (filter user-account? accounts+groups) eq?))
456
457 (define user-specs
458 (map user-account->gexp accounts))
459
460 (define groups
461 (delete-duplicates (filter user-group? accounts+groups) eq?))
462
463 (define group-specs
464 (map user-group->gexp groups))
465
466 (assert-unique-account-names accounts)
467 (assert-unique-group-names groups)
468 (assert-valid-users/groups accounts groups)
469
470 ;; Add users and user groups.
471 (with-imported-modules (source-module-closure '((gnu system accounts)))
472 #~(begin
473 (use-modules (gnu system accounts))
474
475 (activate-users+groups (map sexp->user-account (list #$@user-specs))
476 (map sexp->user-group (list #$@group-specs))))))
477
478(define (account-shepherd-service accounts+groups)
479 "Return a Shepherd service that creates the home directories for the user
480accounts among ACCOUNTS+GROUPS."
481 (define accounts
482 (filter user-account? accounts+groups))
483
484 (define regular-account-names
485 (filter-map (lambda (account)
486 (and (not (user-account-system? account))
487 (user-account-name account)))
488 accounts))
489
490 ;; Create home directories only once 'file-systems' is up. This makes sure
491 ;; they are created in the right place if /home lives on a separate
492 ;; partition.
493 ;;
494 ;; XXX: We arrange for this service to stop right after it's done its job so
495 ;; that 'guix system reconfigure' knows that it can reload it fearlessly
496 ;; (and thus create new home directories).
497 (list (shepherd-service
498 (requirement '(file-systems))
499 (provision '(user-homes))
500 (one-shot? #t)
501 (modules '((gnu build activation)
502 (gnu system accounts)))
503 (start (with-imported-modules (source-module-closure
504 '((gnu build activation)
505 (gnu system accounts)))
506 #~(lambda ()
507 (activate-user-home
508 (map sexp->user-account
509 (list #$@(map user-account->gexp accounts))))
510
511 ;; Create the user's profile directory upfront:
512 ;; guix-daemon lacks permissions to create it when it is
513 ;; running as an unprivileged user.
514 (for-each (lambda (account)
515 (let ((profile (in-vicinity
516 "/var/guix/profiles/per-user"
517 account))
518 (owner (getpwnam account)))
519 (mkdir-p/perms profile owner #o755)))
520 '#$regular-account-names)
521 #t))) ;success
522 (documentation "Create user home directories."))))
523
524(define (shells-file shells)
525 "Return a file-like object that builds a shell list for use as /etc/shells
526based on SHELLS. /etc/shells is used by xterm, polkit, and other programs."
527 (computed-file "shells"
528 #~(begin
529 (use-modules (srfi srfi-1))
530
531 (define shells
532 (delete-duplicates (list #$@shells)))
533
534 (call-with-output-file #$output
535 (lambda (port)
536 (display "\
537/bin/sh
538/run/current-system/profile/bin/sh
539/run/current-system/profile/bin/bash\n" port)
540 (for-each (lambda (shell)
541 (display shell port)
542 (newline port))
543 shells))))))
544(define (etc-files arguments)
545 "Filter out among ARGUMENTS things corresponding to skeletons, and return
546the /etc/skel directory for those."
547 (let ((skels (filter pair? arguments))
548 (users (filter user-account? arguments)))
549 `(("skel" ,(skeleton-directory skels))
550 ("shells" ,(shells-file (map user-account-shell users))))))
551
552(define account-service-type
553 (service-type (name 'account)
554
555 ;; Concatenate <user-account>, <user-group>, and skeleton
556 ;; lists.
557 (compose concatenate)
558 (extend append)
559
560 (extensions
561 (list (service-extension activation-service-type
562 account-activation)
563 (service-extension shepherd-root-service-type
564 account-shepherd-service)
565 ;; Have 'user-processes' depend on 'user-homes' so that
566 ;; daemons start after their home directory has been
567 ;; created.
568 (service-extension user-processes-service-type
569 (const '(user-homes)))
570 (service-extension etc-service-type
571 etc-files)))
572 (default-value '())
573 (description
574 "Ensure the specified user accounts and groups exist, as well
575as each account home directory.")))
576
577(define (account-service accounts+groups skeletons)
578 "Return a <service> that takes care of user accounts and user groups, with
579ACCOUNTS+GROUPS as its initial list of accounts and groups."
580 (service account-service-type
581 (append skeletons accounts+groups)))
582
583
584;;;
585;;; Subids Service.
586;;;
587
588(define* (%root-subid #:optional (start %subordinate-id-min) (count %subordinate-id-count))
589 (subid-range
590 (name "root")
591 (start start)
592 (count count)))
593
594(define-record-type* <subids-configuration>
595 subids-configuration make-subids-configuration
596 subids-configuration?
597 this-subids-configuration
598
599 (add-root? subids-configuration-add-root? ; boolean
600 (default #t))
601 (subgids subids-configuration-subgids ; list of <subid-range>
602 (default '()))
603 (subuids subids-configuration-subuids ; list of <subid-range>
604 (default '())))
605
606(define (subid-range->gexp range)
607 "Turn RANGE, a <subid-range> object, into a list-valued gexp suitable for
608'activate-subuids+subgids'."
609 (define count (subid-range-count range))
610 #~`(#$(subid-range-name range)
611 #$(subid-range-start range)
612 #$(if (and (number? count)
613 (> count 0))
614 count
615 %subordinate-id-count)))
616
617(define (assert-valid-subids ranges)
618 (cond ((>= (fold + 0 (map subid-range-count ranges))
619 (- %subordinate-id-max %subordinate-id-min -1))
620 (raise
621 (formatted-message
622 (G_
623 "The configured ranges are more than the ~a max allowed.")
624 (- %subordinate-id-max %subordinate-id-min -1))))
625 ((any (lambda (r)
626 (define start (subid-range-start r))
627 (and start
628 (< start %subordinate-id-min)))
629 ranges)
630 (raise
631 (formatted-message
632 (G_
633 "One subid-range starts before the minimum allowed sub id ~a.")
634 %subordinate-id-min)))
635 ((any (lambda (r)
636 (define end (subid-range-end r))
637 (and end
638 (> end %subordinate-id-max)))
639 ranges)
640 (raise
641 (formatted-message
642 (G_
643 "One subid-range ends after the maximum allowed sub id ~a.")
644 %subordinate-id-max)))
645 ((any (compose null? subid-range-name)
646 ranges)
647 (raise
648 (formatted-message
649 (G_
650 "One subid-range has a null name."))))
651 ((any (compose string-null? subid-range-name)
652 ranges)
653 (raise
654 (formatted-message
655 (G_
656 "One subid-range has a name equal to the empty string."))))
657 (else #t)))
658
659(define (delete-duplicate-ranges ranges)
660 (delete-duplicates ranges
661 (lambda args
662 (apply string=? (map subid-range-name ranges)))))
663
664(define (subids-activation config)
665 "Return a gexp that activates SUBUIDS+SUBGIDS, a list of <subid-range>
666objects."
667 (define (add-root-when-missing ranges)
668 (define sorted-ranges
669 (sort-list ranges subid-range-less))
670 (define root-missing?
671 (not
672 (find (lambda (r)
673 (string=? "root"
674 (subid-range-name r)))
675 sorted-ranges)))
676 (define first-start
677 (and (> (length sorted-ranges) 0)
678 (subid-range-start (first sorted-ranges))))
679 (define first-has-start?
680 (number? first-start))
681 (define root-start
682 (if first-has-start?
683 (and
684 (> first-start %subordinate-id-min)
685 %subordinate-id-min)
686 %subordinate-id-min))
687 (define root-count
688 (if first-has-start?
689 (- first-start %subordinate-id-min)
690 %subordinate-id-count))
691 (if (and root-missing?
692 (subids-configuration-add-root? config))
693 (append (list (%root-subid root-start root-count))
694 sorted-ranges)
695 sorted-ranges))
696
697 (define subuids
698 (delete-duplicate-ranges (subids-configuration-subuids config)))
699
700 (define subuids-specs
701 (map subid-range->gexp (add-root-when-missing subuids)))
702
703 (define subgids
704 (delete-duplicate-ranges (subids-configuration-subgids config)))
705
706 (define subgids-specs
707 (map subid-range->gexp (add-root-when-missing subgids)))
708
709 (assert-valid-subids subgids)
710 (assert-valid-subids subuids)
711
712 ;; Add subuids and subgids.
713 (with-imported-modules (source-module-closure '((gnu system accounts)))
714 #~(begin
715 (use-modules (gnu system accounts))
716
717 (activate-subuids+subgids (map sexp->subid-range (list #$@subuids-specs))
718 (map sexp->subid-range (list #$@subgids-specs))))))
719
720(define-record-type* <subids-extension>
721 subids-extension make-subids-extension
722 subids-extension?
723 this-subids-extension
724
725 (subgids subids-extension-subgids ; list of <subid-range>
726 (default '()))
727 (subuids subids-extension-subuids ; list of <subid-range>
728 (default '())))
729
730(define append-subid-ranges
731 (lambda args
732 (delete-duplicate-ranges
733 (apply append args))))
734
735(define (subids-extension-merge a b)
736 (subids-extension
737 (subgids (append-subid-ranges
738 (subids-extension-subgids a)
739 (subids-extension-subgids b)))
740 (subuids (append-subid-ranges
741 (subids-extension-subuids a)
742 (subids-extension-subuids b)))))
743
744(define subids-service-type
745 (service-type (name 'subids)
746 ;; Concatenate <subid-range> lists.
747 (compose (lambda (args)
748 (fold subids-extension-merge
749 (subids-extension)
750 args)))
751 (extend
752 (lambda (config extension)
753 (subids-configuration
754 (inherit config)
755 (subgids
756 (append-subid-ranges
757 (subids-configuration-subgids config)
758 (subids-extension-subgids extension)))
759 (subuids
760 (append-subid-ranges
761 (subids-configuration-subuids config)
762 (subids-extension-subuids extension))))))
763 (extensions
764 (list (service-extension activation-service-type
765 subids-activation)))
766 (default-value
767 (subids-configuration))
768 (description
769 "Ensure the specified sub UIDs and sub GIDs exist in
770/etc/subuid and /etc/subgid.")))
771
772;;; shadow.scm ends here