futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

system: Make accounts and groups at activation time.

Browse Source 
* 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 2014-05-11 22:41:01 +02:00
parent 057d6ce5e4
commit ab6a279abb
7 changed files with 186 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
build-aux/hydra/demo-os.scm
View File

@ -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))

10
gnu/services/base.scm
View File

@ -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)))))))))

95
gnu/system.scm
View File

@ -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))

14
gnu/system/linux.scm
View File

@ -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

61
gnu/system/shadow.scm
View File

@ -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

15
gnu/system/vm.scm
View File

@ -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

97
guix/build/activation.scm
View File

@ -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."