2 files changed, 38 insertions(+), 3 deletions(-)

M gnu/system/shadow.scm
M gnu/system/vm.scm

@@ 30,7 30,15 @@
             user-account-home-directory
             user-account-shell
 
-            passwd-file))
+            user-group
+            user-group?
+            user-group-name
+            user-group-password
+            user-group-id
+            user-group-members
+
+            passwd-file
+            group-file))
 
 ;;; Commentary:
 ;;;


@@ 49,6 57,31 @@
   (home-directory user-account-home-directory)
   (shell          user-account-shell (default "/bin/sh")))
 
+(define-record-type* <user-group>
+  user-group make-user-group
+  user-group?
+  (name           user-group-name)
+  (password       user-group-password (default #f))
+  (id             user-group-id)
+  (members        user-group-members (default '())))
+
+(define (group-file store groups)
+  "Return a /etc/group file for GROUPS, a list of <user-group> objects."
+  (define contents
+    (let loop ((groups groups)
+               (result '()))
+      (match groups
+        ((($ <user-group> name _ gid (users ...)) rest ...)
+         ;; XXX: Ignore the group password.
+         (loop rest
+               (cons (string-append name "::" (number->string gid)
+                                    ":" (string-join users ","))
+                     result)))
+        (()
+         (string-join (reverse result) "\n" 'suffix)))))
+
+  (add-text-to-store store "group" contents))
+
 (define* (passwd-file store accounts #:key shadow?)
   "Return a password file for ACCOUNTS, a list of <user-account> objects.  If
 SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd

@@ 484,8 484,10 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30
                              (shell bash-file))))
            (passwd    (passwd-file store accounts))
            (shadow    (passwd-file store accounts #:shadow? #t))
-           (group     (add-text-to-store store "group"
-                                         "root:x:0:\n"))
+           (group     (group-file store
+                                  (list (user-group
+                                         (name "root")
+                                         (id 0)))))
            (pam.d-drv (pam-services->directory store %pam-services))
            (pam.d     (derivation->output-path pam.d-drv))