system: Make sure user accounts refer to existing groups.

Fixes <http://bugs.gnu.org/20646>.
Reported by David Thompson <davet@gnu.org>.

* gnu/system/shadow.scm (assert-valid-users/groups): New procedure
* gnu/system.scm (operating-system-activation-script): Use it.
* tests/guix-system.sh (make_user_config): New function.
  Add 3 tests using it.
* po/guix/POTFILES.in: Add gnu/system/shadow.scm.
This commit is contained in:
Ludovic Courtès 2015-05-24 18:02:54 +02:00
parent 6ec1f4caa3
commit 0c09a306e5
4 changed files with 76 additions and 1 deletions

View File

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

View File

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

View File

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

View File

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