From 6061d01512081c93c53fdd1d4302b36696403061 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 3 Mar 2019 21:57:26 +0100
Subject: activation: Operate on <user-account> and <user-group> records.

* gnu/system/accounts.scm (sexp->user-group, sexp->user-account): New
procedures.
* gnu/system/shadow.scm (account-activation): Call them in the arguments
to 'activate-users+groups'.
(account-shepherd-service): Likewise.
* gnu/build/activation.scm (activate-users+groups): Expect a list of
<user-account> and a list of <user-group>.  Replace uses of 'match' on
tuples with calls to record accessors.
(activate-user-home): Likewise.
---
 gnu/system/accounts.scm | 28 ++++++++++++++++++++++++++++
 gnu/system/shadow.scm   | 22 ++++++++++++++--------
 2 files changed, 42 insertions(+), 8 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 36ee62e851..eb18fb5e43 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -18,6 +18,7 @@
 
 (define-module (gnu system accounts)
   #:use-module (guix records)
+  #:use-module (ice-9 match)
   #:export (user-account
             user-account?
             user-account-name
@@ -38,6 +39,9 @@
             user-group-id
             user-group-system?
 
+            sexp->user-account
+            sexp->user-group
+
             default-shell))
 
 
@@ -79,3 +83,27 @@
   (id             user-group-id (default #f))
   (system?        user-group-system?              ; Boolean
                   (default #f)))
+
+(define (sexp->user-group sexp)
+  "Take SEXP, a tuple as returned by 'user-group->gexp', and turn it into a
+user-group record."
+  (match sexp
+    ((name password id system?)
+     (user-group (name name)
+                 (password password)
+                 (id id)
+                 (system? system?)))))
+
+(define (sexp->user-account sexp)
+  "Take SEXP, a tuple as returned by 'user-account->gexp', and turn it into a
+user-account record."
+  (match sexp
+    ((name uid group supplementary-groups comment home-directory
+           create-home-directory? shell password system?)
+     (user-account (name name) (uid uid) (group group)
+                   (supplementary-groups supplementary-groups)
+                   (comment comment)
+                   (home-directory home-directory)
+                   (create-home-directory? create-home-directory?)
+                   (shell shell) (password password)
+                   (system? system?)))))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index a9a4afd414..4e5b6ae5f2 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -298,11 +298,14 @@ group."
   (assert-valid-users/groups accounts groups)
 
   ;; Add users and user groups.
-  #~(begin
-      (setenv "PATH"
-              (string-append #$(@ (gnu packages admin) shadow) "/sbin"))
-      (activate-users+groups (list #$@user-specs)
-                             (list #$@group-specs))))
+  (with-imported-modules (source-module-closure '((gnu system accounts)))
+    #~(begin
+        (use-modules (gnu system accounts))
+
+        (setenv "PATH"
+                (string-append #$(@ (gnu packages admin) shadow) "/sbin"))
+        (activate-users+groups (map sexp->user-account (list #$@user-specs))
+                               (map sexp->user-group (list #$@group-specs))))))
 
 (define (account-shepherd-service accounts+groups)
   "Return a Shepherd service that creates the home directories for the user
@@ -322,12 +325,15 @@ accounts among ACCOUNTS+GROUPS."
   (list (shepherd-service
          (requirement '(file-systems))
          (provision '(user-homes))
-         (modules '((gnu build activation)))
+         (modules '((gnu build activation)
+                    (gnu system accounts)))
          (start (with-imported-modules (source-module-closure
-                                        '((gnu build activation)))
+                                        '((gnu build activation)
+                                          (gnu system accounts)))
                   #~(lambda ()
                       (activate-user-home
-                       (list #$@(map user-account->gexp accounts)))
+                       (map sexp->user-account
+                            (list #$@(map user-account->gexp accounts))))
                       #f)))                       ;stop
          (stop #~(const #f))
          (respawn? #f)
-- 
cgit v1.2.3