M build-aux/hydra/demo-os.scm => build-aux/hydra/demo-os.scm +2 -1
@@ 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))
M gnu/services/base.scm => gnu/services/base.scm +4 -6
@@ 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)))))))))
M gnu/system.scm => gnu/system.scm +64 -31
@@ 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))
M gnu/system/linux.scm => gnu/system/linux.scm +8 -6
@@ 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
M gnu/system/shadow.scm => gnu/system/shadow.scm +10 -51
@@ 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
M gnu/system/vm.scm => gnu/system/vm.scm +2 -13
@@ 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
M guix/build/activation.scm => guix/build/activation.scm +96 -1
@@ 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."