bug#54666: Installation without non-root user accounts

[Mathieu Othacehe]

Hey Ludo,

> To address that, maybe ‘run-user-add-page’ should explicitly reject
> “root”?

Here are two patches that should fix this issue :).

Thanks,

Mathieu

>From 829c3c2543ffd7f9b22a5e1fb40f7627b2c76414 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Mon, 4 Apr 2022 16:36:07 +0200
Subject: [PATCH 1/2] installer: user: Forbid root user creation.

Forbid root user creation as it could lead to a system without any
non-priviledged user accouts.

Fixes: <https://issues.guix.gnu.org/54666>.

* gnu/installer/newt/user.scm (run-user-add-page): Forbid it.
---
 gnu/installer/newt/user.scm | 51 ++++++++++++++++++++++++-------------
 1 file changed, 33 insertions(+), 18 deletions(-)

diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
index 7c1cc2249d..98b1f5ae9a 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.scm
@@ -40,6 +40,9 @@ (define* (run-user-add-page #:key (name "") (real-name "")
   (define (pad-label label)
     (string-pad-right label 25))
 
+  (define (root-account? name)
+    (string=? name "root"))
+
   (let* ((label-name
           (make-label -1 -1 (pad-label (G_ "Name"))))
          (label-real-name
@@ -116,10 +119,14 @@ (define (pad-label label)
                                GRID-ELEMENT-SUBGRID button-grid)
                               title)
 
-    (let ((error-page
+    (let ((error-empty-field-page
            (lambda ()
              (run-error-page (G_ "Empty inputs are not allowed.")
-                             (G_ "Empty input")))))
+                             (G_ "Empty input"))))
+          (error-root-page
+           (lambda ()
+             (run-error-page (G_ "Root account is automatically created.")
+                             (G_ "Root account")))))
       (receive (exit-reason argument)
           (run-form form)
         (dynamic-wind
@@ -132,22 +139,30 @@ (define (pad-label label)
                       (real-name      (entry-value entry-real-name))
                       (home-directory (entry-value entry-home-directory))
                       (password       (entry-value entry-password)))
-                  (if (or (string=? name "")
-                          (string=? home-directory ""))
-                      (begin
-                        (error-page)
-                        (run-user-add-page))
-                      (let ((password (confirm-password password)))
-                        (if password
-                            (user
-                             (name name)
-                             (real-name real-name)
-                             (home-directory home-directory)
-                             (password (make-secret password)))
-                            (run-user-add-page #:name name
-                                               #:real-name real-name
-                                               #:home-directory
-                                               home-directory)))))))))
+                  (cond
+                   ;; Empty field.
+                   ((or (string=? name "")
+                        (string=? home-directory ""))
+                    (begin
+                      (error-empty-field-page)
+                      (run-user-add-page)))
+                   ;; Reject root account.
+                   ((root-account? name)
+                    (begin
+                      (error-root-page)
+                      (run-user-add-page)))
+                   (else
+                    (let ((password (confirm-password password)))
+                      (if password
+                          (user
+                           (name name)
+                           (real-name real-name)
+                           (home-directory home-directory)
+                           (password (make-secret password)))
+                          (run-user-add-page #:name name
+                                             #:real-name real-name
+                                             #:home-directory
+                                             home-directory))))))))))
           (lambda ()
             (destroy-form-and-pop form)))))))
 
-- 
2.34.0

>From cc32729700caa4b76d112b561a09dd0ff3ada768 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Mon, 4 Apr 2022 16:38:09 +0200
Subject: [PATCH 2/2] installer: user: Remove useless filtering.

* gnu/installer/user.scm (users->configuration): Remove root account filtering
that is now performed in the "run-user-add-page" procedure.
---
 gnu/installer/user.scm | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm
index c894a91dc8..b042c9790d 100644
--- a/gnu/installer/user.scm
+++ b/gnu/installer/user.scm
@@ -69,10 +69,5 @@ (define (user->sexp user)
       (supplementary-groups '("wheel" "netdev"
                               "audio" "video"))))
 
-  `((users (cons*
-            ,@(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))))
+  `((users (cons* ,@(map user->sexp users)
+                  %base-user-accounts))))
-- 
2.34.0