Skip to content
Snippets Groups Projects
Unverified Commit 0ae735bc authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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.
parent ec600e45
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
gnu/build/activation.scm
+ 21
− 188
View file @ 0ae735bc
...@@ -19,11 +19,13 @@ ...@@ -19,11 +19,13 @@
(define-module (gnu build activation) (define-module (gnu build activation)
#:use-module (gnu system accounts) #:use-module (gnu system accounts)
#:use-module (gnu build 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)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (activate-users+groups #:export (activate-users+groups
activate-user-home activate-user-home
...@@ -43,35 +45,6 @@ (define-module (gnu build activation) ...@@ -43,35 +45,6 @@ (define-module (gnu build activation)
;;; ;;;
;;; Code: ;;; 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 (define %skeleton-directory
;; Directory containing skeleton files for new accounts. ;; Directory containing skeleton files for new accounts.
;; Note: keep the trailing '/' so that 'scandir' enters it. ;; Note: keep the trailing '/' so that 'scandir' enters it.
...@@ -117,172 +90,32 @@ (define* (make-skeletons-writable home ...@@ -117,172 +90,32 @@ (define* (make-skeletons-writable home
(make-file-writable target)))) (make-file-writable target))))
files))) 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) (define (activate-users+groups users groups)
"Make sure USERS (a list of user account records) and GROUPS (a list of user "Make sure USERS (a list of user account records) and GROUPS (a list of user
group records) are all available." group records) are all available."
(define (touch file) (define (make-home-directory user)
(close-port (open-file file "a0b"))) (let ((home (user-account-home-directory user))
(pwd (getpwnam (user-account-name user))))
(define activate-user (mkdir-p home)
(lambda (user) (chown home (passwd:uid pwd) (passwd:gid pwd))
(let ((name (user-account-name user)) (chmod home #o700)))
(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")
;; Allow home directories to be created under /var/lib. ;; Allow home directories to be created under /var/lib.
(mkdir-p "/var/lib") (mkdir-p "/var/lib")
;; Create the root account so we can use 'useradd' and 'groupadd'. (let-values (((groups passwd shadow)
(activate-user (find (compose zero? user-account-uid) users)) (user+group-databases users groups)))
(write-group groups)
;; Then create the groups. (write-passwd passwd)
(for-each (lambda (group) (write-shadow shadow)
(let ((name (user-group-name group))
(password (user-group-password group)) ;; Home directories of non-system accounts are created by
(gid (user-group-id group)) ;; 'activate-user-home'.
(system? (user-group-system? group))) (for-each make-home-directory
(unless (false-if-exception (getgrnam name)) (filter (lambda (user)
(add-group name (and (user-account-system? user)
#:gid gid #:password password (user-account-create-home-directory? user)))
#:system? system?)))) users))))
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))))
(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
......
gnu/build/install.scm
+ 1
− 2
View file @ 0ae735bc
;;; 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 © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
...@@ -117,7 +117,6 @@ (define (directives store) ...@@ -117,7 +117,6 @@ (define (directives store)
(directory "/var/tmp" 0 0 #o1777) (directory "/var/tmp" 0 0 #o1777)
(directory "/var/lock" 0 0 #o1777) (directory "/var/lock" 0 0 #o1777)
(directory "/root" 0 0) ; an exception
(directory "/home" 0 0))) (directory "/home" 0 0)))
(define (populate-root-file-system system target) (define (populate-root-file-system system target)
......
gnu/system/shadow.scm
+ 0
− 2
View file @ 0ae735bc
...@@ -302,8 +302,6 @@ (define group-specs ...@@ -302,8 +302,6 @@ (define group-specs
#~(begin #~(begin
(use-modules (gnu system accounts)) (use-modules (gnu system accounts))
(setenv "PATH"
(string-append #$(@ (gnu packages admin) shadow) "/sbin"))
(activate-users+groups (map sexp->user-account (list #$@user-specs)) (activate-users+groups (map sexp->user-account (list #$@user-specs))
(map sexp->user-group (list #$@group-specs)))))) (map sexp->user-group (list #$@group-specs))))))
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment