From 91a7c4998fe4f5a2a63f2ddb4bfeeef81c68b6d7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 24 Apr 2019 21:54:28 +0200
Subject: installer: Ask for the root account password.

Fixes <https://bugs.gnu.org/35399>.

* gnu/installer/newt/user.scm (run-root-password-page): New procedure.
* gnu/installer/user.scm (users->configuration): Filter out the "root"
account.
* gnu/installer/final.scm (create-user-database): Set 'uid' field in
'user-account' form.
---
 gnu/installer/final.scm     |  4 ++++
 gnu/installer/newt/user.scm | 15 ++++++++++++++-
 gnu/installer/user.scm      | 25 +++++++++++++++----------
 3 files changed, 33 insertions(+), 11 deletions(-)

(limited to 'gnu')

diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 4cf34d0457..bf68a5aa2c 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -67,8 +67,12 @@ (define (salt)
 
   (define users*
     (map (lambda (user)
+           (define root?
+             (string=? "root" (user-name user)))
+
            (sys:user-account (name (user-name user))
                              (group "users")
+                             (uid (if root? 0 #f))
                              (home-directory
                               (user-home-directory user))
                              (password (crypt (user-password user)
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
index 032f9b9276..327e294362 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.scm
@@ -104,6 +104,14 @@ (define (pad-label label)
           (lambda ()
             (destroy-form-and-pop form)))))))
 
+(define (run-root-password-page)
+  ;; TRANSLATORS: Leave "root" untranslated: it refers to the name of the
+  ;; system administrator account.
+  (run-input-page (G_ "Please choose a password for the system \
+administrator (\"root\").")
+                  (G_ "System administrator password")
+                  #:input-flags FLAG-PASSWORD))
+
 (define (run-user-page)
   (define (run users)
     (let* ((listbox (make-listbox
@@ -181,4 +189,9 @@ (define (run users)
                 users))))
           (lambda ()
             (destroy-form-and-pop form))))))
-  (run '()))
+
+  ;; Add a "root" user simply to convey the root password.
+  (cons (user (name "root")
+              (home-directory "/root")
+              (password (run-root-password-page)))
+        (run '())))
diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm
index fe755ad2c6..29fab6414e 100644
--- a/gnu/installer/user.scm
+++ b/gnu/installer/user.scm
@@ -18,6 +18,7 @@
 
 (define-module (gnu installer user)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
   #:export (<user>
             user
             make-user
@@ -39,14 +40,18 @@ (define-record-type* <user>
 
 (define (users->configuration users)
   "Return the configuration field for USERS."
+  (define (user->sexp user)
+    `(user-account
+      (name ,(user-name user))
+      (group ,(user-group user))
+      (home-directory ,(user-home-directory user))
+      (supplementary-groups '("wheel" "netdev"
+                              "audio" "video"))))
+
   `((users (cons*
-             ,@(map (lambda (user)
-                      `(user-account
-                        (name ,(user-name user))
-                        (group ,(user-group user))
-                        (home-directory ,(user-home-directory user))
-                        (supplementary-groups
-                         (quote ("wheel" "netdev"
-                                 "audio" "video")))))
-                    users)
-             %base-user-accounts))))
+            ,@(filter-map (lambda (user)
+                            ;; Do not emit a 'user-account' form for "root".
+                            (and (not (string=? (user-name user) "root"))
+                                 (user->sexp user)))
+                          users)
+            %base-user-accounts))))
-- 
cgit v1.2.3