From f6f67b87c08fe7b901db834c714aceaef2b62b60 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 3 Mar 2019 11:46:43 +0100 Subject: system: Add (gnu system accounts). The (gnu system accounts) module is meant to be used both on the build- and on the host-side. * gnu/system/shadow.scm : Call 'default-shell'. (, ): Move to... * gnu/system/accounts.scm: ... here. New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add system/accounts.scm. --- gnu/system/shadow.scm | 76 ++++++++++++++++++--------------------------------- 1 file changed, 27 insertions(+), 49 deletions(-) (limited to 'gnu/system/shadow.scm') diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 63f544cec9..a9a4afd414 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 Alex Griffin ;;; ;;; This file is part of GNU Guix. @@ -24,6 +24,7 @@ #:use-module (guix modules) #:use-module (guix sets) #:use-module (guix ui) + #:use-module (gnu system accounts) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module ((gnu system file-systems) @@ -36,27 +37,29 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:export (user-account - user-account? - user-account-name - user-account-password - user-account-uid - user-account-group - user-account-supplementary-groups - user-account-comment - user-account-home-directory - user-account-create-home-directory? - user-account-shell - user-account-system? - - user-group - user-group? - user-group-name - user-group-password - user-group-id - user-group-system? - - default-skeletons + + ;; Re-export these bindings for backward compatibility. + #:re-export (user-account + user-account? + user-account-name + user-account-password + user-account-uid + user-account-group + user-account-supplementary-groups + user-account-comment + user-account-home-directory + user-account-create-home-directory? + user-account-shell + user-account-system? + + user-group + user-group? + user-group-name + user-group-password + user-group-id + user-group-system?) + + #:export (default-skeletons skeleton-directory %base-groups %base-user-accounts @@ -70,33 +73,8 @@ ;;; ;;; Code: -(define-record-type* - user-account make-user-account - user-account? - (name user-account-name) - (password user-account-password (default #f)) - (uid user-account-uid (default #f)) - (group user-account-group) ; number | string - (supplementary-groups user-account-supplementary-groups - (default '())) ; list of strings - (comment user-account-comment (default "")) - (home-directory user-account-home-directory) - (create-home-directory? user-account-create-home-directory? ;Boolean - (default #t)) - (shell user-account-shell ; gexp - (default (file-append bash "/bin/bash"))) - (system? user-account-system? ; Boolean - (default #f))) - -(define-record-type* - user-group make-user-group - user-group? - (name user-group-name) - (password user-group-password (default #f)) - (id user-group-id (default #f)) - (system? user-group-system? ; Boolean - (default #f))) - +;; Change the default shell used by new records. +(default-shell (file-append bash "/bin/bash")) (define %base-groups ;; Default set of groups. -- cgit 1.4.1 From 6061d01512081c93c53fdd1d4302b36696403061 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 3 Mar 2019 21:57:26 +0100 Subject: activation: Operate on and 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 and a list of . Replace uses of 'match' on tuples with calls to record accessors. (activate-user-home): Likewise. --- gnu/build/activation.scm | 122 ++++++++++++++++++++++++----------------------- gnu/system/accounts.scm | 28 +++++++++++ gnu/system/shadow.scm | 22 +++++---- 3 files changed, 105 insertions(+), 67 deletions(-) (limited to 'gnu/system/shadow.scm') 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 +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see . (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) -- cgit 1.4.1 From 0ae735bcc8ff7fdc89d67b492bdee9091ee19e86 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 3 Mar 2019 23:16:41 +0100 Subject: 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. --- gnu/build/activation.scm | 209 +++++------------------------------------------ gnu/build/install.scm | 3 +- gnu/system/shadow.scm | 2 - 3 files changed, 22 insertions(+), 192 deletions(-) (limited to 'gnu/system/shadow.scm') 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 +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; ;;; 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) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 4e5b6ae5f2..7dc36f4a45 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -302,8 +302,6 @@ group." #~(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)))))) -- cgit 1.4.1