mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
system: Make accounts and groups at activation time.
* gnu/services/base.scm (guix-build-accounts): Remove #:gid parameter;
add #:group. Remove 'password' and 'gid' fields in 'user-account'
form, and add 'group'.
(guix-service): Remove #:build-user-gid parameter. Remove 'id' field
in 'user-group' form.
* gnu/system.scm (etc-directory): Remove #:groups and #:accounts. No
longer produce files "passwd", "shadow", and "group". Adjust caller
accordingly.
(%root-account): New variable.
(operating-system-accounts): Add 'users' variable. Add %ROOT-ACCOUNT
only of 'operating-system-users' doesn't already contain a root
account.
(user-group->gexp, user-account->gexp): New procedures.
(operating-system-boot-script): Add calls to 'setenv' and
'activate-users+groups' in gexp.
* gnu/system/linux.scm (base-pam-services): Add PAM services for
"user{add,del,mode}" and "group{add,del,mod}".
* gnu/system/shadow.scm (<user-account>)[gid]: Rename to...
[group]: ... this.
[supplementary-groups]: New field.
[uid, password]: Default to #f.
(<user-group>)[id]: Default to #f.
(group-file, passwd-file): Remove.
* gnu/system/vm.scm (operating-system-default-contents)[user-directories]:
Remove. Add "/home" to the directives.
* guix/build/activation.scm (add-group, add-user,
activate-users+groups): New procedures.
This commit is contained in:
Ludovic Courtès
parent
057d6ce5e4
commit
ab6a279abb
|
|
@ -45,7 +45,8 @@
|
|||
(locale "en_US.UTF-8")
|
||||
(users (list (user-account
|
||||
(name "guest")
|
||||
(uid 1000) (gid 100)
|
||||
(group "wheel")
|
||||
(password "")
|
||||
(comment "Guest of GNU")
|
||||
(home-directory "/home/guest"))))
|
||||
(groups (list (user-group (name "root") (id 0))
|
||||
|
|
|
|||
|
|
@ -237,8 +237,8 @@ stopped before 'kill' is called."
|
|||
(stop #~(make-kill-destructor))))))
|
||||
|
||||
(define* (guix-build-accounts count #:key
|
||||
(group "guixbuild")
|
||||
(first-uid 30001)
|
||||
(gid 30000)
|
||||
(shadow shadow))
|
||||
"Return a list of COUNT user accounts for Guix build users, with UIDs
|
||||
starting at FIRST-UID, and under GID."
|
||||
|
|
@ -247,9 +247,8 @@ starting at FIRST-UID, and under GID."
|
|||
(lambda (n)
|
||||
(user-account
|
||||
(name (format #f "guixbuilder~2,'0d" n))
|
||||
(password "!")
|
||||
(uid (+ first-uid n -1))
|
||||
(gid gid)
|
||||
(group group)
|
||||
(comment (format #f "Guix Build User ~2d" n))
|
||||
(home-directory "/var/empty")
|
||||
(shell #~(string-append #$shadow "/sbin/nologin"))))
|
||||
|
|
@ -257,11 +256,11 @@ starting at FIRST-UID, and under GID."
|
|||
1))))
|
||||
|
||||
(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
|
||||
(build-user-gid 30000) (build-accounts 10))
|
||||
(build-accounts 10))
|
||||
"Return a service that runs the build daemon from GUIX, and has
|
||||
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
|
||||
(mlet %store-monad ((accounts (guix-build-accounts build-accounts
|
||||
#:gid build-user-gid)))
|
||||
#:group builder-group)))
|
||||
(return (service
|
||||
(provision '(guix-daemon))
|
||||
(requirement '(user-processes))
|
||||
|
|
@ -274,7 +273,6 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
|
|||
(user-accounts accounts)
|
||||
(user-groups (list (user-group
|
||||
(name builder-group)
|
||||
(id build-user-gid)
|
||||
(members (map user-account-name
|
||||
user-accounts)))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -224,17 +224,12 @@ explicitly appear in OS."
|
|||
|
||||
(define* (etc-directory #:key
|
||||
(locale "C") (timezone "Europe/Paris")
|
||||
(accounts '())
|
||||
(groups '())
|
||||
(pam-services '())
|
||||
(profile "/var/run/current-system/profile")
|
||||
(sudoers ""))
|
||||
"Return a derivation that builds the static part of the /etc directory."
|
||||
(mlet* %store-monad
|
||||
((passwd (passwd-file accounts))
|
||||
(shadow (passwd-file accounts #:shadow? #t))
|
||||
(group (group-file groups))
|
||||
(pam.d (pam-services->directory pam-services))
|
||||
((pam.d (pam-services->directory pam-services))
|
||||
(sudoers (text-file "sudoers" sudoers))
|
||||
(login.defs (text-file "login.defs" "# Empty for now.\n"))
|
||||
(shells (text-file "shells" ; used by xterm and others
|
||||
|
|
@ -278,10 +273,6 @@ alias ll='ls -l'
|
|||
("profile" ,#~#$bashrc)
|
||||
("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
|
||||
#$timezone))
|
||||
("passwd" ,#~#$passwd)
|
||||
("shadow" ,#~#$shadow)
|
||||
("group" ,#~#$group)
|
||||
|
||||
("sudoers" ,#~#$sudoers)))))
|
||||
|
||||
(define (operating-system-profile os)
|
||||
|
|
@ -290,18 +281,28 @@ alias ll='ls -l'
|
|||
(union (operating-system-packages os)
|
||||
#:name "default-profile"))
|
||||
|
||||
(define %root-account
|
||||
;; Default root account.
|
||||
(user-account
|
||||
(name "root")
|
||||
(password "")
|
||||
(uid 0) (group "root")
|
||||
(comment "System administrator")
|
||||
(home-directory "/root")))
|
||||
|
||||
(define (operating-system-accounts os)
|
||||
"Return the user accounts for OS, including an obligatory 'root' account."
|
||||
(define users
|
||||
;; Make sure there's a root account.
|
||||
(if (find (lambda (user)
|
||||
(and=> (user-account-uid user) zero?))
|
||||
(operating-system-users os))
|
||||
(operating-system-users os)
|
||||
(cons %root-account (operating-system-users os))))
|
||||
|
||||
(mlet %store-monad ((services (operating-system-services os)))
|
||||
(return (cons (user-account
|
||||
(name "root")
|
||||
(password "")
|
||||
(uid 0) (gid 0)
|
||||
(comment "System administrator")
|
||||
(home-directory "/root"))
|
||||
(append (operating-system-users os)
|
||||
(append-map service-user-accounts
|
||||
services))))))
|
||||
(return (append users
|
||||
(append-map service-user-accounts services)))))
|
||||
|
||||
(define (operating-system-etc-directory os)
|
||||
"Return that static part of the /etc directory of OS."
|
||||
|
|
@ -312,12 +313,8 @@ alias ll='ls -l'
|
|||
(delete-duplicates
|
||||
(append (operating-system-pam-services os)
|
||||
(append-map service-pam-services services))))
|
||||
(accounts (operating-system-accounts os))
|
||||
(profile-drv (operating-system-profile os))
|
||||
(groups -> (append (operating-system-groups os)
|
||||
(append-map service-user-groups services))))
|
||||
(etc-directory #:accounts accounts #:groups groups
|
||||
#:pam-services pam-services
|
||||
(profile-drv (operating-system-profile os)))
|
||||
(etc-directory #:pam-services pam-services
|
||||
#:locale (operating-system-locale os)
|
||||
#:timezone (operating-system-timezone os)
|
||||
#:sudoers (operating-system-sudoers os)
|
||||
|
|
@ -339,6 +336,25 @@ alias ll='ls -l'
|
|||
"root ALL=(ALL) ALL
|
||||
%wheel ALL=(ALL) ALL\n")
|
||||
|
||||
(define (user-group->gexp group)
|
||||
"Turn GROUP, a <user-group> object, into a list-valued gexp suitable for
|
||||
'active-groups'."
|
||||
#~(list #$(user-group-name group)
|
||||
#$(user-group-password group)
|
||||
#$(user-group-id group)))
|
||||
|
||||
(define (user-account->gexp account)
|
||||
"Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for
|
||||
'activate-users'."
|
||||
#~`(#$(user-account-name account)
|
||||
#$(user-account-uid account)
|
||||
#$(user-account-group account)
|
||||
#$(user-account-supplementary-groups account)
|
||||
#$(user-account-comment account)
|
||||
#$(user-account-home-directory account)
|
||||
,#$(user-account-shell account) ; this one is a gexp
|
||||
#$(user-account-password account)))
|
||||
|
||||
(define (operating-system-boot-script os)
|
||||
"Return the boot script for OS---i.e., the code started by the initrd once
|
||||
we're running in the final root."
|
||||
|
|
@ -346,15 +362,25 @@ we're running in the final root."
|
|||
'((guix build activation)
|
||||
(guix build utils)))
|
||||
|
||||
(mlet* %store-monad
|
||||
((services (operating-system-services os))
|
||||
(etc (operating-system-etc-directory os))
|
||||
(modules (imported-modules %modules))
|
||||
(compiled (compiled-modules %modules))
|
||||
(dmd-conf (dmd-configuration-file services)))
|
||||
(mlet* %store-monad ((services (operating-system-services os))
|
||||
(etc (operating-system-etc-directory os))
|
||||
(modules (imported-modules %modules))
|
||||
(compiled (compiled-modules %modules))
|
||||
(dmd-conf (dmd-configuration-file services))
|
||||
(accounts (operating-system-accounts os)))
|
||||
(define setuid-progs
|
||||
(operating-system-setuid-programs os))
|
||||
|
||||
(define user-specs
|
||||
(map user-account->gexp accounts))
|
||||
|
||||
(define groups
|
||||
(append (operating-system-groups os)
|
||||
(append-map service-user-groups services)))
|
||||
|
||||
(define group-specs
|
||||
(map user-group->gexp groups))
|
||||
|
||||
(gexp->file "boot"
|
||||
#~(begin
|
||||
(eval-when (expand load eval)
|
||||
|
|
@ -368,6 +394,13 @@ we're running in the final root."
|
|||
;; Populate /etc.
|
||||
(activate-etc #$etc)
|
||||
|
||||
;; Add users and user groups.
|
||||
(setenv "PATH"
|
||||
(string-append #$(@ (gnu packages admin) shadow)
|
||||
"/sbin"))
|
||||
(activate-users+groups (list #$@user-specs)
|
||||
(list #$@group-specs))
|
||||
|
||||
;; Activate setuid programs.
|
||||
(activate-setuid-programs (list #$@setuid-progs))
|
||||
|
||||
|
|
|
|||
|
|
@ -154,11 +154,13 @@ should be the name of a file used as the message-of-the-day."
|
|||
|
||||
(define* (base-pam-services #:key allow-empty-passwords?)
|
||||
"Return the list of basic PAM services everyone would want."
|
||||
(list %pam-other-services
|
||||
(unix-pam-service "su" #:allow-empty-passwords? allow-empty-passwords?)
|
||||
(unix-pam-service "passwd"
|
||||
#:allow-empty-passwords? allow-empty-passwords?)
|
||||
(unix-pam-service "sudo"
|
||||
#:allow-empty-passwords? allow-empty-passwords?)))
|
||||
(cons %pam-other-services
|
||||
(map (cut unix-pam-service <>
|
||||
#:allow-empty-passwords? allow-empty-passwords?)
|
||||
'("su" "passwd" "sudo"
|
||||
"useradd" "userdel" "usermod"
|
||||
"groupadd" "groupdel" "groupmod"
|
||||
;; TODO: Add other Shadow programs?
|
||||
))))
|
||||
|
||||
;;; linux.scm ends here
|
||||
|
|
|
|||
|
|
@ -30,9 +30,10 @@
|
|||
#:export (user-account
|
||||
user-account?
|
||||
user-account-name
|
||||
user-account-pass
|
||||
user-account-password
|
||||
user-account-uid
|
||||
user-account-gid
|
||||
user-account-group
|
||||
user-account-supplementary-groups
|
||||
user-account-comment
|
||||
user-account-home-directory
|
||||
user-account-shell
|
||||
|
|
@ -42,11 +43,7 @@
|
|||
user-group-name
|
||||
user-group-password
|
||||
user-group-id
|
||||
user-group-members
|
||||
|
||||
passwd-file
|
||||
group-file
|
||||
guix-build-accounts))
|
||||
user-group-members))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -58,9 +55,11 @@
|
|||
user-account make-user-account
|
||||
user-account?
|
||||
(name user-account-name)
|
||||
(password user-account-pass (default ""))
|
||||
(uid user-account-uid)
|
||||
(gid user-account-gid)
|
||||
(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)
|
||||
(shell user-account-shell ; gexp
|
||||
|
|
@ -71,47 +70,7 @@
|
|||
user-group?
|
||||
(name user-group-name)
|
||||
(password user-group-password (default #f))
|
||||
(id user-group-id)
|
||||
(id user-group-id (default #f))
|
||||
(members user-group-members (default '())))
|
||||
|
||||
(define (group-file groups)
|
||||
"Return a /etc/group file for GROUPS, a list of <user-group> objects."
|
||||
(define contents
|
||||
(let loop ((groups groups)
|
||||
(result '()))
|
||||
(match groups
|
||||
((($ <user-group> name _ gid (users ...)) rest ...)
|
||||
;; XXX: Ignore the group password.
|
||||
(loop rest
|
||||
(cons (string-append name "::" (number->string gid)
|
||||
":" (string-join users ","))
|
||||
result)))
|
||||
(()
|
||||
(string-join (reverse result) "\n" 'suffix)))))
|
||||
|
||||
(text-file "group" contents))
|
||||
|
||||
(define* (passwd-file accounts #:key shadow?)
|
||||
"Return a password file for ACCOUNTS, a list of <user-account> objects. If
|
||||
SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd
|
||||
file."
|
||||
;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
|
||||
(define account-exp
|
||||
(match-lambda
|
||||
(($ <user-account> name pass uid gid comment home-dir shell)
|
||||
(if shadow? ; XXX: use (crypt PASS …)?
|
||||
#~(format #t "~a::::::::~%" #$name)
|
||||
#~(format #t "~a:x:~a:~a:~a:~a:~a~%"
|
||||
#$name #$(number->string uid) #$(number->string gid)
|
||||
#$comment #$home-dir #$shell)))))
|
||||
|
||||
(define builder
|
||||
#~(begin
|
||||
(with-output-to-file #$output
|
||||
(lambda ()
|
||||
#$@(map account-exp accounts)
|
||||
#t))))
|
||||
|
||||
(gexp->derivation (if shadow? "shadow" "passwd") builder))
|
||||
|
||||
;;; shadow.scm ends here
|
||||
|
|
|
|||
|
|
@ -267,16 +267,6 @@ such as /etc files."
|
|||
(define (operating-system-default-contents os)
|
||||
"Return a list of directives suitable for 'system-qemu-image' describing the
|
||||
basic contents of the root file system of OS."
|
||||
(define (user-directories user)
|
||||
(let ((home (user-account-home-directory user))
|
||||
;; XXX: Deal with automatically allocated ids.
|
||||
(uid (or (user-account-uid user) 0))
|
||||
(gid (or (user-account-gid user) 0))
|
||||
(root (string-append "/var/guix/profiles/per-user/"
|
||||
(user-account-name user))))
|
||||
#~((directory #$root #$uid #$gid)
|
||||
(directory #$home #$uid #$gid))))
|
||||
|
||||
(mlet* %store-monad ((os-drv (operating-system-derivation os))
|
||||
(build-gid (operating-system-build-gid os))
|
||||
(profile (operating-system-profile os)))
|
||||
|
|
@ -293,9 +283,8 @@ basic contents of the root file system of OS."
|
|||
(directory "/tmp")
|
||||
(directory "/var/guix/profiles/per-user/root" 0 0)
|
||||
|
||||
(directory "/root" 0 0) ; an exception
|
||||
#$@(append-map user-directories
|
||||
(operating-system-users os))))))
|
||||
(directory "/root" 0 0) ; an exception
|
||||
(directory "/home" 0 0)))))
|
||||
|
||||
(define* (system-qemu-image os
|
||||
#:key
|
||||
|
|
|
|||
|
|
@ -19,8 +19,11 @@
|
|||
(define-module (guix build activation)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (activate-etc
|
||||
#:export (activate-users+groups
|
||||
activate-etc
|
||||
activate-setuid-programs))
|
||||
|
||||
;;; Commentary:
|
||||
|
|
@ -31,6 +34,98 @@
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define* (add-group name #:key gid password
|
||||
(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) '())
|
||||
,name)))
|
||||
(zero? (apply system* "groupadd" args))))
|
||||
|
||||
(define* (add-user name group
|
||||
#:key uid comment home shell password
|
||||
(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.
|
||||
(begin
|
||||
(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)
|
||||
#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 "--create-home") '())
|
||||
,@(if shell `("-s" ,shell) '())
|
||||
,@(if password `("-p" ,password) '())
|
||||
,name)))
|
||||
(zero? (apply system* "useradd" args)))))
|
||||
|
||||
(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."
|
||||
(define (touch file)
|
||||
(call-with-output-file file (const #t)))
|
||||
|
||||
(define activate-user
|
||||
(match-lambda
|
||||
((name uid group supplementary-groups comment home shell password)
|
||||
(unless (false-if-exception (getpwnam name))
|
||||
(let ((profile-dir (string-append "/var/guix/profiles/per-user/"
|
||||
name)))
|
||||
(add-user name group
|
||||
#:uid uid
|
||||
#:supplementary-groups supplementary-groups
|
||||
#:comment comment
|
||||
#:home home
|
||||
#:shell shell
|
||||
#:password password)
|
||||
|
||||
;; 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")
|
||||
|
||||
;; Create the root account so we can use 'useradd' and 'groupadd'.
|
||||
(activate-user (find (match-lambda
|
||||
((name (? zero?) _ ...) #t)
|
||||
(_ #f))
|
||||
users))
|
||||
|
||||
;; Then create the groups.
|
||||
(for-each (match-lambda
|
||||
((name password gid)
|
||||
(add-group name #:gid gid #:password password)))
|
||||
groups)
|
||||
|
||||
;; Finally create the other user accounts.
|
||||
(for-each activate-user users))
|
||||
|
||||
(define (activate-etc etc)
|
||||
"Install ETC, a directory in the store, as the source of static files for
|
||||
/etc."
|
||||
|
|
|
|||
Loading…
Reference in a new issue