diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-05-24 18:02:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-05-24 18:02:54 +0200 |
| commit | 0c09a306e59e2feec9818335b0b4f3355c02f420 (patch) | |
| tree | b554200d7969247f47ebfbb4ed9c81dd572cdce5 /gnu | |
| parent | 6ec1f4caa34d350d9f8b90b71192c1d32807d934 (diff) | |
| download | guix-0c09a306e59e2feec9818335b0b4f3355c02f420.tar.gz | |
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.scm | 2 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 35 |
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 |