From 2bfb27af56e2e1ef1699c8ec63d3badeb211b58e Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 4 Apr 2022 16:36:07 +0200 Subject: installer: user: Forbid root user creation. Forbid root user creation as it could lead to a system without any non-priviledged user accouts. Fixes: . * gnu/installer/newt/user.scm (run-user-add-page): Forbid it. --- gnu/installer/newt/user.scm | 49 ++++++++++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 18 deletions(-) (limited to 'gnu/installer') diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm index 7c1cc2249d..a1c797688e 100644 --- a/gnu/installer/newt/user.scm +++ b/gnu/installer/newt/user.scm @@ -40,6 +40,9 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form." (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 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form." 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,28 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form." (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 "")) + (error-empty-field-page) + (run-user-add-page)) + ;; Reject root account. + ((root-account? name) + (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))))))) -- cgit v1.2.3 From c2125e59d0774cda3e559adeb056459a5f23586b Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 4 Apr 2022 16:38:09 +0200 Subject: 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(-) (limited to 'gnu/installer') 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 @@ (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)))) -- cgit v1.2.3 From 48c748226e2a94d2dec9bfdf84601455f00d6f5e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 20 May 2022 20:41:02 +0200 Subject: Revert "installer: user: Remove useless filtering." This reverts commit c2125e59d0774cda3e559adeb056459a5f23586b. Fixes . --- gnu/installer/user.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'gnu/installer') diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm index b042c9790d..c894a91dc8 100644 --- a/gnu/installer/user.scm +++ b/gnu/installer/user.scm @@ -69,5 +69,10 @@ (supplementary-groups '("wheel" "netdev" "audio" "video")))) - `((users (cons* ,@(map user->sexp users) - %base-user-accounts)))) + `((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)))) -- cgit v1.2.3