From 16a0e9dc3449fb9de699486ad6db2c0bc62b616b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 26 Sep 2013 22:02:02 +0200
Subject: [PATCH] gnu: shadow: Add record type for user groups.

* gnu/system/shadow.scm (<user-group>): New record type.
  (group-file): New procedure.
* gnu/system/vm.scm (system-qemu-image): Use it.
---
 gnu/system/shadow.scm | 35 ++++++++++++++++++++++++++++++++++-
 gnu/system/vm.scm     |  6 ++++--
 2 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index c748596431..b2a2121b08 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.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
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index ce15ace617..48f008cff0 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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))