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