ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

activation: Build account databases with (gnu build accounts).

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2019-03-03 23:16:41 +01:00
parent ec600e4544
commit 0ae735bcc8
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 21 additions and 191 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

207
gnu/build/activation.scm
View file

@ -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 @@ (define-module (gnu build activation)
;;;
;;; 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 @@ (define* (make-skeletons-writable 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))
(let-values (((groups passwd shadow)
(user+group-databases users groups)))
(write-group groups)
(write-passwd passwd)
(write-shadow shadow)
;; 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))))
;; 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

3
gnu/build/install.scm
View file

@ -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 @@ (define (directives 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)

2
gnu/system/shadow.scm
View file

@ -302,8 +302,6 @@ (define group-specs
#~(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))))))