From 6061d01512081c93c53fdd1d4302b36696403061 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 3 Mar 2019 21:57:26 +0100 Subject: activation: Operate on and 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 and a list of . Replace uses of 'match' on tuples with calls to record accessors. (activate-user-home): Likewise. --- gnu/system/accounts.scm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'gnu/system/accounts.scm') 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?))))) -- cgit v1.2.3