summaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-03 23:16:41 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-07 20:05:09 +0100
commit0ae735bcc8ff7fdc89d67b492bdee9091ee19e86 (patch)
tree23c345bf4f49ea368b3c6b304ef2f058ee95de6c /gnu/build
parentec600e4544729f1aaf46fa5162bba334515d0de5 (diff)
activation: Build account databases with (gnu build accounts).
* gnu/build/activation.scm (enumerate, current-users, current-groups) (add-group, add-user, modify-user, ensure-user): Remove. (activate-users+groups)[touch, activate-user]: Remove. [make-home-directory]: New procedure. Rewrite in terms of 'user+group-databases', 'write-group', etc. * gnu/build/install.scm (directives): Remove "/root". * gnu/system/shadow.scm (account-activation): Remove (setenv "PATH" ...) expression, which is now unneeded.
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/activation.scm209
-rw-r--r--gnu/build/install.scm3
2 files changed, 22 insertions, 190 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index e777015980..f24e6029fa 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -19,11 +19,13 @@
(define-module (gnu build activation)
#:use-module (gnu system accounts)
+ #:use-module (gnu build accounts)
#:use-module (gnu build linux-boot)
#:use-module (guix build utils)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (activate-users+groups
activate-user-home
@@ -43,35 +45,6 @@
;;;
;;; Code:
-(define (enumerate thunk)
- "Return the list of values returned by THUNK until it returned #f."
- (let loop ((entry (thunk))
- (result '()))
- (if (not entry)
- (reverse result)
- (loop (thunk) (cons entry result)))))
-
-(define (current-users)
- "Return the passwd entries for all the currently defined user accounts."
- (setpw)
- (enumerate getpwent))
-
-(define (current-groups)
- "Return the group entries for all the currently defined user groups."
- (setgr)
- (enumerate getgrent))
-
-(define* (add-group name #:key gid password system?
- (log-port (current-error-port)))
- "Add NAME as a user group, with the given numeric GID if specified."
- ;; Use 'groupadd' from the Shadow package.
- (format log-port "adding group '~a'...~%" name)
- (let ((args `(,@(if gid `("-g" ,(number->string gid)) '())
- ,@(if password `("-p" ,password) '())
- ,@(if system? `("--system") '())
- ,name)))
- (zero? (apply system* "groupadd" args))))
-
(define %skeleton-directory
;; Directory containing skeleton files for new accounts.
;; Note: keep the trailing '/' so that 'scandir' enters it.
@@ -117,172 +90,32 @@ owner-writable in HOME."
(make-file-writable target))))
files)))
-(define* (add-user name group
- #:key uid comment home create-home?
- shell password system?
- (supplementary-groups '())
- (log-port (current-error-port)))
- "Create an account for user NAME part of GROUP, with the specified
-properties. Return #t on success."
- (format log-port "adding user '~a'...~%" name)
-
- (if (and uid (zero? uid))
-
- ;; 'useradd' fails with "Cannot determine your user name" if the root
- ;; account doesn't exist. Thus, for bootstrapping purposes, create that
- ;; one manually.
- (let ((home (or home "/root")))
- (call-with-output-file "/etc/shadow"
- (cut format <> "~a::::::::~%" name))
- (call-with-output-file "/etc/passwd"
- (cut format <> "~a:x:~a:~a:~a:~a:~a~%"
- name "0" "0" comment home shell))
- (chmod "/etc/shadow" #o600)
- (copy-account-skeletons home)
- (chmod home #o700)
- #t)
-
- ;; Use 'useradd' from the Shadow package.
- (let ((args `(,@(if uid `("-u" ,(number->string uid)) '())
- "-g" ,(if (number? group) (number->string group) group)
- ,@(if (pair? supplementary-groups)
- `("-G" ,(string-join supplementary-groups ","))
- '())
- ,@(if comment `("-c" ,comment) '())
- ,@(if home `("-d" ,home) '())
-
- ;; Home directories of non-system accounts are created by
- ;; 'activate-user-home'.
- ,@(if (and home create-home? system?
- (not (file-exists? home)))
- '("--create-home")
- '())
-
- ,@(if shell `("-s" ,shell) '())
- ,@(if password `("-p" ,password) '())
- ,@(if system? '("--system") '())
- ,name)))
- (and (zero? (apply system* "useradd" args))
- (begin
- ;; Since /etc/skel is a link to a directory in the store where
- ;; all files have the writable bit cleared, and since 'useradd'
- ;; preserves permissions when it copies them, explicitly make
- ;; them writable.
- (make-skeletons-writable home)
- #t)))))
-
-(define* (modify-user name group
- #:key uid comment home create-home?
- shell password system?
- (supplementary-groups '())
- (log-port (current-error-port)))
- "Modify user account NAME to have all the given settings."
- ;; Use 'usermod' from the Shadow package.
- (let ((args `(,@(if uid `("-u" ,(number->string uid)) '())
- "-g" ,(if (number? group) (number->string group) group)
- ,@(if (pair? supplementary-groups)
- `("-G" ,(string-join supplementary-groups ","))
- '())
- ,@(if comment `("-c" ,comment) '())
- ;; Don't use '--move-home'.
- ,@(if home `("-d" ,home) '())
- ,@(if shell `("-s" ,shell) '())
- ,name)))
- (zero? (apply system* "usermod" args))))
-
-(define* (delete-user name #:key (log-port (current-error-port)))
- "Remove user account NAME. Return #t on success. This may fail if NAME is
-logged in."
- (format log-port "deleting user '~a'...~%" name)
- (zero? (system* "userdel" name)))
-
-(define* (delete-group name #:key (log-port (current-error-port)))
- "Remove group NAME. Return #t on success."
- (format log-port "deleting group '~a'...~%" name)
- (zero? (system* "groupdel" name)))
-
-(define* (ensure-user name group
- #:key uid comment home create-home?
- shell password system?
- (supplementary-groups '())
- (log-port (current-error-port))
- #:rest rest)
- "Make sure user NAME exists and has the relevant settings."
- (if (false-if-exception (getpwnam name))
- (apply modify-user name group rest)
- (apply add-user name group rest)))
-
(define (activate-users+groups users groups)
"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
- (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")
+ (define (make-home-directory user)
+ (let ((home (user-account-home-directory user))
+ (pwd (getpwnam (user-account-name user))))
+ (mkdir-p home)
+ (chown home (passwd:uid pwd) (passwd:gid pwd))
+ (chmod home #o700)))
;; Allow home directories to be created under /var/lib.
(mkdir-p "/var/lib")
- ;; Create the root account so we can use 'useradd' and 'groupadd'.
- (activate-user (find (compose zero? user-account-uid) users))
-
- ;; Then create the groups.
- (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.
- (for-each activate-user users)
-
- ;; Finally, delete extra user accounts and groups.
- (for-each delete-user
- (lset-difference string=?
- (map passwd:name (current-users))
- (map user-account-name users)))
- (for-each delete-group
- (lset-difference string=?
- (map group:name (current-groups))
- (map user-group-name groups))))
+ (let-values (((groups passwd shadow)
+ (user+group-databases users groups)))
+ (write-group groups)
+ (write-passwd passwd)
+ (write-shadow shadow)
+
+ ;; Home directories of non-system accounts are created by
+ ;; 'activate-user-home'.
+ (for-each make-home-directory
+ (filter (lambda (user)
+ (and (user-account-system? user)
+ (user-account-create-home-directory? user)))
+ users))))
(define (activate-user-home users)
"Create and populate the home directory of USERS, a list of tuples, unless
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index c9ebe124fe..c0d4d44091 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.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 © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -117,7 +117,6 @@ STORE."
(directory "/var/tmp" 0 0 #o1777)
(directory "/var/lock" 0 0 #o1777)
- (directory "/root" 0 0) ; an exception
(directory "/home" 0 0)))
(define (populate-root-file-system system target)