1 files changed, 45 insertions, 1 deletions

diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 16b9e4b555..aa97652678 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,9 @@
 
             default-skeletons
             skeleton-directory
-            %base-groups))
+            %base-groups
+            %base-user-accounts
+            assert-valid-users/groups))
 
 ;;; Commentary:
 ;;;
@@ -107,6 +114,16 @@
           (system-group (name "tape"))
           (system-group (name "kvm")))))             ; for /dev/kvm
 
+(define %base-user-accounts
+  ;; List of standard user accounts.  Note that "root" is a special case, so
+  ;; it's not listed here.
+  (list (user-account
+         (name "nobody")
+         (uid 65534)
+         (group "nogroup")
+         (home-directory "/var/empty")
+         (system? #t))))
+
 (define (default-skeletons)
   "Return the default skeleton files for /etc/skel.  These files are copied by
 'useradd' in the home directory of newly created user accounts."
@@ -176,4 +193,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