summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/activation.scm122
-rw-r--r--gnu/system/accounts.scm28
-rw-r--r--gnu/system/shadow.scm22
3 files changed, 105 insertions, 67 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index d516f5bdc9..e777015980 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -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?
-
- #: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))))))))
+ (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)
+
+ (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))
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)