diff options
| -rw-r--r-- | gnu/system.scm | 2 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 35 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
| -rw-r--r-- | tests/guix-system.sh | 39 |
4 files changed, 76 insertions, 1 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index b8d0e62f60..79de80a3eb 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -686,6 +686,8 @@ etc." (define group-specs (map user-group->gexp groups)) + (assert-valid-users/groups accounts groups) + (gexp->file "activate" #~(begin (eval-when (expand load eval) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 16b9e4b555..a778b87306 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -21,12 +21,17 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix sets) + #:use-module (guix ui) #:use-module ((gnu system file-systems) #:select (%tty-gid)) #:use-module ((gnu packages admin) #:select (shadow)) #:use-module (gnu packages bash) #:use-module (gnu packages guile-wm) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:export (user-account user-account? user-account-name @@ -48,7 +53,8 @@ default-skeletons skeleton-directory - %base-groups)) + %base-groups + assert-valid-users/groups)) ;;; Commentary: ;;; @@ -176,4 +182,31 @@ set debug-file-directory ~/.guix-profile/lib/debug\n"))) '#$skeletons) #t))) +(define (assert-valid-users/groups users groups) + "Raise an error if USERS refer to groups not listed in GROUPS." + (let ((groups (list->set (map user-group-name groups)))) + (define (validate-supplementary-group user group) + (unless (set-contains? groups group) + (raise (condition + (&message + (message + (format #f (_ "supplementary group '~a' \ +of user '~a' is undeclared") + group + (user-account-name user)))))))) + + (for-each (lambda (user) + (unless (set-contains? groups (user-account-group user)) + (raise (condition + (&message + (message + (format #f (_ "primary group '~a' \ +of user '~a' is undeclared") + (user-account-group user) + (user-account-name user))))))) + + (for-each (cut validate-supplementary-group user <>) + (user-account-supplementary-groups user))) + users))) + ;;; shadow.scm ends here diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 30ce28b712..59f353e427 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -3,6 +3,7 @@ gnu/packages.scm gnu/system.scm gnu/services/dmd.scm +gnu/system/shadow.scm guix/scripts/build.scm guix/scripts/download.scm guix/scripts/package.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 1b77d1a0db..7008ef8031 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -76,3 +76,42 @@ then else grep "service 'networking'.*more than once" "$errorfile" fi + +make_user_config () +{ + cat > "$tmpfile" <<EOF +(use-modules (gnu)) +(use-service-modules networking) + +(operating-system + (host-name "antelope") + (timezone "Europe/Paris") + (locale "en_US.UTF-8") + + (bootloader (grub-configuration (device "/dev/sdX"))) + (file-systems (cons (file-system + (device "root") + (title 'label) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (users (list (user-account + (name "dave") + (home-directory "/home/dave") + (group "$1") + (supplementary-groups '("$2")))))) +EOF +} + +make_user_config "users" "wheel" +guix system build "$tmpfile" -n # succeeds + +make_user_config "group-that-does-not-exist" "users" +if guix system build "$tmpfile" -n 2> "$errorfile" +then false +else grep "primary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi + +make_user_config "users" "group-that-does-not-exist" +if guix system build "$tmpfile" -n 2> "$errorfile" +then false +else grep "supplementary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi |