me
/
guix
Archived
1
0
Fork 0
Code

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 2019-03-03 21:57:26 +01:00
parent f6f67b87c0
commit 6061d01512
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 103 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
gnu/build/activation.scm
View File

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

28
gnu/system/accounts.scm
View File

@ -18,6 +18,7 @@
(define-module (gnu system accounts) (define-module (gnu system accounts)
#:use-module (guix records) #:use-module (guix records)
#:use-module (ice-9 match)
#:export (user-account #:export (user-account
user-account? user-account?
user-account-name user-account-name
@ -38,6 +39,9 @@
user-group-id user-group-id
user-group-system? user-group-system?
sexp->user-account
sexp->user-group
default-shell)) default-shell))
@ -79,3 +83,27 @@
(id user-group-id (default #f)) (id user-group-id (default #f))
(system? user-group-system? ; Boolean (system? user-group-system? ; Boolean
(default #f))) (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?)))))

22
gnu/system/shadow.scm
View File

@ -298,11 +298,14 @@ group."
(assert-valid-users/groups accounts groups) (assert-valid-users/groups accounts groups)
;; Add users and user groups. ;; Add users and user groups.
#~(begin (with-imported-modules (source-module-closure '((gnu system accounts)))
(setenv "PATH" #~(begin
(string-append #$(@ (gnu packages admin) shadow) "/sbin")) (use-modules (gnu system accounts))
(activate-users+groups (list #$@user-specs)
(list #$@group-specs)))) (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) (define (account-shepherd-service accounts+groups)
"Return a Shepherd service that creates the home directories for the user "Return a Shepherd service that creates the home directories for the user
@ -322,12 +325,15 @@ accounts among ACCOUNTS+GROUPS."
(list (shepherd-service (list (shepherd-service
(requirement '(file-systems)) (requirement '(file-systems))
(provision '(user-homes)) (provision '(user-homes))
(modules '((gnu build activation))) (modules '((gnu build activation)
(gnu system accounts)))
(start (with-imported-modules (source-module-closure (start (with-imported-modules (source-module-closure
'((gnu build activation))) '((gnu build activation)
(gnu system accounts)))
#~(lambda () #~(lambda ()
(activate-user-home (activate-user-home
(list #$@(map user-account->gexp accounts))) (map sexp->user-account
(list #$@(map user-account->gexp accounts))))
#f))) ;stop #f))) ;stop
(stop #~(const #f)) (stop #~(const #f))
(respawn? #f) (respawn? #f)