aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/system.scm2
-rw-r--r--gnu/system/shadow.scm35
-rw-r--r--po/guix/POTFILES.in1
-rw-r--r--tests/guix-system.sh39
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