4 files changed, 76 insertions(+), 1 deletions(-)

M gnu/system.scm
M gnu/system/shadow.scm
M po/guix/POTFILES.in
M tests/guix-system.sh

@@ 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)

@@ 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

@@ 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

@@ 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