mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05: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:
parent
057d6ce5e4
commit
ab6a279abb
7 changed files with 186 additions and 109 deletions
|
@ -45,7 +45,8 @@
|
||||||
(locale "en_US.UTF-8")
|
(locale "en_US.UTF-8")
|
||||||
(users (list (user-account
|
(users (list (user-account
|
||||||
(name "guest")
|
(name "guest")
|
||||||
(uid 1000) (gid 100)
|
(group "wheel")
|
||||||
|
(password "")
|
||||||
(comment "Guest of GNU")
|
(comment "Guest of GNU")
|
||||||
(home-directory "/home/guest"))))
|
(home-directory "/home/guest"))))
|
||||||
(groups (list (user-group (name "root") (id 0))
|
(groups (list (user-group (name "root") (id 0))
|
||||||
|
|
|
@ -237,8 +237,8 @@ (define contents "
|
||||||
(stop #~(make-kill-destructor))))))
|
(stop #~(make-kill-destructor))))))
|
||||||
|
|
||||||
(define* (guix-build-accounts count #:key
|
(define* (guix-build-accounts count #:key
|
||||||
|
(group "guixbuild")
|
||||||
(first-uid 30001)
|
(first-uid 30001)
|
||||||
(gid 30000)
|
|
||||||
(shadow shadow))
|
(shadow shadow))
|
||||||
"Return a list of COUNT user accounts for Guix build users, with UIDs
|
"Return a list of COUNT user accounts for Guix build users, with UIDs
|
||||||
starting at FIRST-UID, and under GID."
|
starting at FIRST-UID, and under GID."
|
||||||
|
@ -247,9 +247,8 @@ (define* (guix-build-accounts count #:key
|
||||||
(lambda (n)
|
(lambda (n)
|
||||||
(user-account
|
(user-account
|
||||||
(name (format #f "guixbuilder~2,'0d" n))
|
(name (format #f "guixbuilder~2,'0d" n))
|
||||||
(password "!")
|
|
||||||
(uid (+ first-uid n -1))
|
(uid (+ first-uid n -1))
|
||||||
(gid gid)
|
(group group)
|
||||||
(comment (format #f "Guix Build User ~2d" n))
|
(comment (format #f "Guix Build User ~2d" n))
|
||||||
(home-directory "/var/empty")
|
(home-directory "/var/empty")
|
||||||
(shell #~(string-append #$shadow "/sbin/nologin"))))
|
(shell #~(string-append #$shadow "/sbin/nologin"))))
|
||||||
|
@ -257,11 +256,11 @@ (define* (guix-build-accounts count #:key
|
||||||
1))))
|
1))))
|
||||||
|
|
||||||
(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
|
(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
|
"Return a service that runs the build daemon from GUIX, and has
|
||||||
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
|
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
|
||||||
(mlet %store-monad ((accounts (guix-build-accounts build-accounts
|
(mlet %store-monad ((accounts (guix-build-accounts build-accounts
|
||||||
#:gid build-user-gid)))
|
#:group builder-group)))
|
||||||
(return (service
|
(return (service
|
||||||
(provision '(guix-daemon))
|
(provision '(guix-daemon))
|
||||||
(requirement '(user-processes))
|
(requirement '(user-processes))
|
||||||
|
@ -274,7 +273,6 @@ (define* (guix-service #:key (guix guix) (builder-group "guixbuild")
|
||||||
(user-accounts accounts)
|
(user-accounts accounts)
|
||||||
(user-groups (list (user-group
|
(user-groups (list (user-group
|
||||||
(name builder-group)
|
(name builder-group)
|
||||||
(id build-user-gid)
|
|
||||||
(members (map user-account-name
|
(members (map user-account-name
|
||||||
user-accounts)))))))))
|
user-accounts)))))))))
|
||||||
|
|
||||||
|
|
|
@ -224,17 +224,12 @@ (define (operating-system-services os)
|
||||||
|
|
||||||
(define* (etc-directory #:key
|
(define* (etc-directory #:key
|
||||||
(locale "C") (timezone "Europe/Paris")
|
(locale "C") (timezone "Europe/Paris")
|
||||||
(accounts '())
|
|
||||||
(groups '())
|
|
||||||
(pam-services '())
|
(pam-services '())
|
||||||
(profile "/var/run/current-system/profile")
|
(profile "/var/run/current-system/profile")
|
||||||
(sudoers ""))
|
(sudoers ""))
|
||||||
"Return a derivation that builds the static part of the /etc directory."
|
"Return a derivation that builds the static part of the /etc directory."
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((passwd (passwd-file accounts))
|
((pam.d (pam-services->directory pam-services))
|
||||||
(shadow (passwd-file accounts #:shadow? #t))
|
|
||||||
(group (group-file groups))
|
|
||||||
(pam.d (pam-services->directory pam-services))
|
|
||||||
(sudoers (text-file "sudoers" sudoers))
|
(sudoers (text-file "sudoers" sudoers))
|
||||||
(login.defs (text-file "login.defs" "# Empty for now.\n"))
|
(login.defs (text-file "login.defs" "# Empty for now.\n"))
|
||||||
(shells (text-file "shells" ; used by xterm and others
|
(shells (text-file "shells" ; used by xterm and others
|
||||||
|
@ -278,10 +273,6 @@ (define* (etc-directory #:key
|
||||||
("profile" ,#~#$bashrc)
|
("profile" ,#~#$bashrc)
|
||||||
("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
|
("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
|
||||||
#$timezone))
|
#$timezone))
|
||||||
("passwd" ,#~#$passwd)
|
|
||||||
("shadow" ,#~#$shadow)
|
|
||||||
("group" ,#~#$group)
|
|
||||||
|
|
||||||
("sudoers" ,#~#$sudoers)))))
|
("sudoers" ,#~#$sudoers)))))
|
||||||
|
|
||||||
(define (operating-system-profile os)
|
(define (operating-system-profile os)
|
||||||
|
@ -290,18 +281,28 @@ (define (operating-system-profile os)
|
||||||
(union (operating-system-packages os)
|
(union (operating-system-packages os)
|
||||||
#:name "default-profile"))
|
#: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)
|
(define (operating-system-accounts os)
|
||||||
"Return the user accounts for OS, including an obligatory 'root' account."
|
"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)))
|
(mlet %store-monad ((services (operating-system-services os)))
|
||||||
(return (cons (user-account
|
(return (append users
|
||||||
(name "root")
|
(append-map service-user-accounts services)))))
|
||||||
(password "")
|
|
||||||
(uid 0) (gid 0)
|
|
||||||
(comment "System administrator")
|
|
||||||
(home-directory "/root"))
|
|
||||||
(append (operating-system-users os)
|
|
||||||
(append-map service-user-accounts
|
|
||||||
services))))))
|
|
||||||
|
|
||||||
(define (operating-system-etc-directory os)
|
(define (operating-system-etc-directory os)
|
||||||
"Return that static part of the /etc directory of OS."
|
"Return that static part of the /etc directory of OS."
|
||||||
|
@ -312,12 +313,8 @@ (define (operating-system-etc-directory os)
|
||||||
(delete-duplicates
|
(delete-duplicates
|
||||||
(append (operating-system-pam-services os)
|
(append (operating-system-pam-services os)
|
||||||
(append-map service-pam-services services))))
|
(append-map service-pam-services services))))
|
||||||
(accounts (operating-system-accounts os))
|
(profile-drv (operating-system-profile os)))
|
||||||
(profile-drv (operating-system-profile os))
|
(etc-directory #:pam-services pam-services
|
||||||
(groups -> (append (operating-system-groups os)
|
|
||||||
(append-map service-user-groups services))))
|
|
||||||
(etc-directory #:accounts accounts #:groups groups
|
|
||||||
#:pam-services pam-services
|
|
||||||
#:locale (operating-system-locale os)
|
#:locale (operating-system-locale os)
|
||||||
#:timezone (operating-system-timezone os)
|
#:timezone (operating-system-timezone os)
|
||||||
#:sudoers (operating-system-sudoers os)
|
#:sudoers (operating-system-sudoers os)
|
||||||
|
@ -339,6 +336,25 @@ (define %sudoers-specification
|
||||||
"root ALL=(ALL) ALL
|
"root ALL=(ALL) ALL
|
||||||
%wheel ALL=(ALL) ALL\n")
|
%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)
|
(define (operating-system-boot-script os)
|
||||||
"Return the boot script for OS---i.e., the code started by the initrd once
|
"Return the boot script for OS---i.e., the code started by the initrd once
|
||||||
we're running in the final root."
|
we're running in the final root."
|
||||||
|
@ -346,15 +362,25 @@ (define %modules
|
||||||
'((guix build activation)
|
'((guix build activation)
|
||||||
(guix build utils)))
|
(guix build utils)))
|
||||||
|
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad ((services (operating-system-services os))
|
||||||
((services (operating-system-services os))
|
(etc (operating-system-etc-directory os))
|
||||||
(etc (operating-system-etc-directory os))
|
(modules (imported-modules %modules))
|
||||||
(modules (imported-modules %modules))
|
(compiled (compiled-modules %modules))
|
||||||
(compiled (compiled-modules %modules))
|
(dmd-conf (dmd-configuration-file services))
|
||||||
(dmd-conf (dmd-configuration-file services)))
|
(accounts (operating-system-accounts os)))
|
||||||
(define setuid-progs
|
(define setuid-progs
|
||||||
(operating-system-setuid-programs os))
|
(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"
|
(gexp->file "boot"
|
||||||
#~(begin
|
#~(begin
|
||||||
(eval-when (expand load eval)
|
(eval-when (expand load eval)
|
||||||
|
@ -368,6 +394,13 @@ (define setuid-progs
|
||||||
;; Populate /etc.
|
;; Populate /etc.
|
||||||
(activate-etc #$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.
|
||||||
(activate-setuid-programs (list #$@setuid-progs))
|
(activate-setuid-programs (list #$@setuid-progs))
|
||||||
|
|
||||||
|
|
|
@ -154,11 +154,13 @@ (module "pam_motd.so")
|
||||||
|
|
||||||
(define* (base-pam-services #:key allow-empty-passwords?)
|
(define* (base-pam-services #:key allow-empty-passwords?)
|
||||||
"Return the list of basic PAM services everyone would want."
|
"Return the list of basic PAM services everyone would want."
|
||||||
(list %pam-other-services
|
(cons %pam-other-services
|
||||||
(unix-pam-service "su" #:allow-empty-passwords? allow-empty-passwords?)
|
(map (cut unix-pam-service <>
|
||||||
(unix-pam-service "passwd"
|
#:allow-empty-passwords? allow-empty-passwords?)
|
||||||
#:allow-empty-passwords? allow-empty-passwords?)
|
'("su" "passwd" "sudo"
|
||||||
(unix-pam-service "sudo"
|
"useradd" "userdel" "usermod"
|
||||||
#:allow-empty-passwords? allow-empty-passwords?)))
|
"groupadd" "groupdel" "groupmod"
|
||||||
|
;; TODO: Add other Shadow programs?
|
||||||
|
))))
|
||||||
|
|
||||||
;;; linux.scm ends here
|
;;; linux.scm ends here
|
||||||
|
|
|
@ -30,9 +30,10 @@ (define-module (gnu system shadow)
|
||||||
#:export (user-account
|
#:export (user-account
|
||||||
user-account?
|
user-account?
|
||||||
user-account-name
|
user-account-name
|
||||||
user-account-pass
|
user-account-password
|
||||||
user-account-uid
|
user-account-uid
|
||||||
user-account-gid
|
user-account-group
|
||||||
|
user-account-supplementary-groups
|
||||||
user-account-comment
|
user-account-comment
|
||||||
user-account-home-directory
|
user-account-home-directory
|
||||||
user-account-shell
|
user-account-shell
|
||||||
|
@ -42,11 +43,7 @@ (define-module (gnu system shadow)
|
||||||
user-group-name
|
user-group-name
|
||||||
user-group-password
|
user-group-password
|
||||||
user-group-id
|
user-group-id
|
||||||
user-group-members
|
user-group-members))
|
||||||
|
|
||||||
passwd-file
|
|
||||||
group-file
|
|
||||||
guix-build-accounts))
|
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -58,9 +55,11 @@ (define-record-type* <user-account>
|
||||||
user-account make-user-account
|
user-account make-user-account
|
||||||
user-account?
|
user-account?
|
||||||
(name user-account-name)
|
(name user-account-name)
|
||||||
(password user-account-pass (default ""))
|
(password user-account-password (default #f))
|
||||||
(uid user-account-uid)
|
(uid user-account-uid (default #f))
|
||||||
(gid user-account-gid)
|
(group user-account-group) ; number | string
|
||||||
|
(supplementary-groups user-account-supplementary-groups
|
||||||
|
(default '())) ; list of strings
|
||||||
(comment user-account-comment (default ""))
|
(comment user-account-comment (default ""))
|
||||||
(home-directory user-account-home-directory)
|
(home-directory user-account-home-directory)
|
||||||
(shell user-account-shell ; gexp
|
(shell user-account-shell ; gexp
|
||||||
|
@ -71,47 +70,7 @@ (define-record-type* <user-group>
|
||||||
user-group?
|
user-group?
|
||||||
(name user-group-name)
|
(name user-group-name)
|
||||||
(password user-group-password (default #f))
|
(password user-group-password (default #f))
|
||||||
(id user-group-id)
|
(id user-group-id (default #f))
|
||||||
(members user-group-members (default '())))
|
(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
|
;;; shadow.scm ends here
|
||||||
|
|
|
@ -267,16 +267,6 @@ (define (operating-system-build-gid os)
|
||||||
(define (operating-system-default-contents os)
|
(define (operating-system-default-contents os)
|
||||||
"Return a list of directives suitable for 'system-qemu-image' describing the
|
"Return a list of directives suitable for 'system-qemu-image' describing the
|
||||||
basic contents of the root file system of OS."
|
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))
|
(mlet* %store-monad ((os-drv (operating-system-derivation os))
|
||||||
(build-gid (operating-system-build-gid os))
|
(build-gid (operating-system-build-gid os))
|
||||||
(profile (operating-system-profile os)))
|
(profile (operating-system-profile os)))
|
||||||
|
@ -293,9 +283,8 @@ (define (user-directories user)
|
||||||
(directory "/tmp")
|
(directory "/tmp")
|
||||||
(directory "/var/guix/profiles/per-user/root" 0 0)
|
(directory "/var/guix/profiles/per-user/root" 0 0)
|
||||||
|
|
||||||
(directory "/root" 0 0) ; an exception
|
(directory "/root" 0 0) ; an exception
|
||||||
#$@(append-map user-directories
|
(directory "/home" 0 0)))))
|
||||||
(operating-system-users os))))))
|
|
||||||
|
|
||||||
(define* (system-qemu-image os
|
(define* (system-qemu-image os
|
||||||
#:key
|
#:key
|
||||||
|
|
|
@ -19,8 +19,11 @@
|
||||||
(define-module (guix build activation)
|
(define-module (guix build activation)
|
||||||
#: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 (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:export (activate-etc
|
#:export (activate-users+groups
|
||||||
|
activate-etc
|
||||||
activate-setuid-programs))
|
activate-setuid-programs))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
@ -31,6 +34,98 @@ (define-module (guix build activation)
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; 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)
|
(define (activate-etc etc)
|
||||||
"Install ETC, a directory in the store, as the source of static files for
|
"Install ETC, a directory in the store, as the source of static files for
|
||||||
/etc."
|
/etc."
|
||||||
|
|
Loading…
Reference in a new issue