aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-05-24 18:02:54 +0200
committerLudovic Courtès <ludo@gnu.org>2015-05-24 18:02:54 +0200
commit0c09a306e59e2feec9818335b0b4f3355c02f420 (patch)
treeb554200d7969247f47ebfbb4ed9c81dd572cdce5 /gnu
parent6ec1f4caa34d350d9f8b90b71192c1d32807d934 (diff)
downloadguix-0c09a306e59e2feec9818335b0b4f3355c02f420.tar.gz
guix-0c09a306e59e2feec9818335b0b4f3355c02f420.zip
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.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/system.scm2
-rw-r--r--gnu/system/shadow.scm35
2 files changed, 36 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