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 @@ (define groups (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 @@ (define-module (gnu system shadow) #: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 @@ (define-module (gnu system shadow) default-skeletons skeleton-directory - %base-groups)) + %base-groups + assert-valid-users/groups)) ;;; Commentary: ;;; @@ -176,4 +182,31 @@ (define (skeleton-directory skeletons) '#$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" < "$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