TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Mathieu Othacehe 2022-04-04 16:36:07 +02:00
parent 3b262b51fa
commit 2bfb27af56
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 31 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
gnu/installer/newt/user.scm
View File

@ -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)))))))