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.master
Ludovic Courtès
parent
f6f67b87c0
commit
6061d01512
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
|
@ -18,6 +18,7 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gnu build activation)
|
||||
#:use-module (gnu system accounts)
|
||||
#:use-module (gnu build linux-boot)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (ice-9 ftw)
|
||||
|
|
@ -212,37 +213,42 @@ logged in."
|
|||
(apply add-user name group rest)))
|
||||
|
||||
(define (activate-users+groups users groups)
|
||||
"Make sure the accounts listed in USERS and the user groups listed in GROUPS
|
||||
are all available.
|
||||
|
||||
Each item in USERS is a list of all the characteristics of a user account;
|
||||
each item in GROUPS is a tuple with the group name, group password or #f, and
|
||||
numeric gid or #f."
|
||||
"Make sure USERS (a list of user account records) and GROUPS (a list of user
|
||||
group records) are all available."
|
||||
(define (touch file)
|
||||
(close-port (open-file file "a0b")))
|
||||
|
||||
(define activate-user
|
||||
(match-lambda
|
||||
((name uid group supplementary-groups comment home create-home?
|
||||
shell password system?)
|
||||
(let ((profile-dir (string-append "/var/guix/profiles/per-user/"
|
||||
name)))
|
||||
(ensure-user name group
|
||||
#:uid uid
|
||||
#:system? system?
|
||||
#:supplementary-groups supplementary-groups
|
||||
#:comment comment
|
||||
#:home home
|
||||
#:create-home? create-home?
|
||||
(lambda (user)
|
||||
(let ((name (user-account-name user))
|
||||
(uid (user-account-uid user))
|
||||
(group (user-account-group user))
|
||||
(supplementary-groups
|
||||
(user-account-supplementary-groups user))
|
||||
(comment (user-account-comment user))
|
||||
(home (user-account-home-directory user))
|
||||
(create-home? (user-account-create-home-directory? user))
|
||||
(shell (user-account-shell user))
|
||||
(password (user-account-password user))
|
||||
(system? (user-account-system? user)))
|
||||
(let ((profile-dir (string-append "/var/guix/profiles/per-user/"
|
||||
name)))
|
||||
(ensure-user name group
|
||||
#:uid uid
|
||||
#:system? system?
|
||||
#:supplementary-groups supplementary-groups
|
||||
#:comment comment
|
||||
#:home home
|
||||
#:create-home? create-home?
|
||||
|
||||
#:shell shell
|
||||
#:password password)
|
||||
#:shell shell
|
||||
#:password password)
|
||||
|
||||
(unless system?
|
||||
;; Create the profile directory for the new account.
|
||||
(let ((pw (getpwnam name)))
|
||||
(mkdir-p profile-dir)
|
||||
(chown profile-dir (passwd:uid pw) (passwd:gid pw))))))))
|
||||
(unless system?
|
||||
;; Create the profile directory for the new account.
|
||||
(let ((pw (getpwnam name)))
|
||||
(mkdir-p profile-dir)
|
||||
(chown profile-dir (passwd:uid pw) (passwd:gid pw))))))))
|
||||
|
||||
;; 'groupadd' aborts if the file doesn't already exist.
|
||||
(touch "/etc/group")
|
||||
|
|
@ -251,18 +257,18 @@ numeric gid or #f."
|
|||
(mkdir-p "/var/lib")
|
||||
|
||||
;; Create the root account so we can use 'useradd' and 'groupadd'.
|
||||
(activate-user (find (match-lambda
|
||||
((name (? zero?) _ ...) #t)
|
||||
(_ #f))
|
||||
users))
|
||||
(activate-user (find (compose zero? user-account-uid) users))
|
||||
|
||||
;; Then create the groups.
|
||||
(for-each (match-lambda
|
||||
((name password gid system?)
|
||||
(unless (false-if-exception (getgrnam name))
|
||||
(add-group name
|
||||
#:gid gid #:password password
|
||||
#:system? system?))))
|
||||
(for-each (lambda (group)
|
||||
(let ((name (user-group-name group))
|
||||
(password (user-group-password group))
|
||||
(gid (user-group-id group))
|
||||
(system? (user-group-system? group)))
|
||||
(unless (false-if-exception (getgrnam name))
|
||||
(add-group name
|
||||
#:gid gid #:password password
|
||||
#:system? system?))))
|
||||
groups)
|
||||
|
||||
;; Create the other user accounts.
|
||||
|
|
@ -272,35 +278,33 @@ numeric gid or #f."
|
|||
(for-each delete-user
|
||||
(lset-difference string=?
|
||||
(map passwd:name (current-users))
|
||||
(match users
|
||||
(((names . _) ...)
|
||||
names))))
|
||||
(map user-account-name users)))
|
||||
(for-each delete-group
|
||||
(lset-difference string=?
|
||||
(map group:name (current-groups))
|
||||
(match groups
|
||||
(((names . _) ...)
|
||||
names)))))
|
||||
(map user-group-name groups))))
|
||||
|
||||
(define (activate-user-home users)
|
||||
"Create and populate the home directory of USERS, a list of tuples, unless
|
||||
they already exist."
|
||||
(define ensure-user-home
|
||||
(match-lambda
|
||||
((name uid group supplementary-groups comment home create-home?
|
||||
shell password system?)
|
||||
;; The home directories of system accounts are created during
|
||||
;; activation, not here.
|
||||
(unless (or (not home) (not create-home?) system?
|
||||
(directory-exists? home))
|
||||
(let* ((pw (getpwnam name))
|
||||
(uid (passwd:uid pw))
|
||||
(gid (passwd:gid pw)))
|
||||
(mkdir-p home)
|
||||
(chown home uid gid)
|
||||
(chmod home #o700)
|
||||
(copy-account-skeletons home
|
||||
#:uid uid #:gid gid))))))
|
||||
(lambda (user)
|
||||
(let ((name (user-account-name user))
|
||||
(home (user-account-home-directory user))
|
||||
(create-home? (user-account-create-home-directory? user))
|
||||
(system? (user-account-system? user)))
|
||||
;; The home directories of system accounts are created during
|
||||
;; activation, not here.
|
||||
(unless (or (not home) (not create-home?) system?
|
||||
(directory-exists? home))
|
||||
(let* ((pw (getpwnam name))
|
||||
(uid (passwd:uid pw))
|
||||
(gid (passwd:gid pw)))
|
||||
(mkdir-p home)
|
||||
(chown home uid gid)
|
||||
(chmod home #o700)
|
||||
(copy-account-skeletons home
|
||||
#:uid uid #:gid gid))))))
|
||||
|
||||
(for-each ensure-user-home users))
|
||||
|
||||
|
|
|
|||
|
|
@ -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?)))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue