From ab6a279abbfa39b1e1bec0e363744d241972f844 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 11 May 2014 22:41:01 +0200
Subject: 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.
---
 guix/build/activation.scm | 97 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 96 insertions(+), 1 deletion(-)

(limited to 'guix/build')

diff --git a/guix/build/activation.scm b/guix/build/activation.scm
index f9d9ba5cbd..895f2bca5b 100644
--- a/guix/build/activation.scm
+++ b/guix/build/activation.scm
@@ -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."
-- 
cgit v1.2.3