mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 06:06:53 -05:00
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:
parent
3b262b51fa
commit
2bfb27af56
1 changed files with 31 additions and 18 deletions
|
@ -40,6 +40,9 @@ (define* (run-user-add-page #:key (name "") (real-name "")
|
||||||
(define (pad-label label)
|
(define (pad-label label)
|
||||||
(string-pad-right label 25))
|
(string-pad-right label 25))
|
||||||
|
|
||||||
|
(define (root-account? name)
|
||||||
|
(string=? name "root"))
|
||||||
|
|
||||||
(let* ((label-name
|
(let* ((label-name
|
||||||
(make-label -1 -1 (pad-label (G_ "Name"))))
|
(make-label -1 -1 (pad-label (G_ "Name"))))
|
||||||
(label-real-name
|
(label-real-name
|
||||||
|
@ -116,10 +119,14 @@ (define (pad-label label)
|
||||||
GRID-ELEMENT-SUBGRID button-grid)
|
GRID-ELEMENT-SUBGRID button-grid)
|
||||||
title)
|
title)
|
||||||
|
|
||||||
(let ((error-page
|
(let ((error-empty-field-page
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(run-error-page (G_ "Empty inputs are not allowed.")
|
(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)
|
(receive (exit-reason argument)
|
||||||
(run-form form)
|
(run-form form)
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
|
@ -132,22 +139,28 @@ (define (pad-label label)
|
||||||
(real-name (entry-value entry-real-name))
|
(real-name (entry-value entry-real-name))
|
||||||
(home-directory (entry-value entry-home-directory))
|
(home-directory (entry-value entry-home-directory))
|
||||||
(password (entry-value entry-password)))
|
(password (entry-value entry-password)))
|
||||||
(if (or (string=? name "")
|
(cond
|
||||||
(string=? home-directory ""))
|
;; Empty field.
|
||||||
(begin
|
((or (string=? name "")
|
||||||
(error-page)
|
(string=? home-directory ""))
|
||||||
(run-user-add-page))
|
(error-empty-field-page)
|
||||||
(let ((password (confirm-password password)))
|
(run-user-add-page))
|
||||||
(if password
|
;; Reject root account.
|
||||||
(user
|
((root-account? name)
|
||||||
(name name)
|
(error-root-page)
|
||||||
(real-name real-name)
|
(run-user-add-page))
|
||||||
(home-directory home-directory)
|
(else
|
||||||
(password (make-secret password)))
|
(let ((password (confirm-password password)))
|
||||||
(run-user-add-page #:name name
|
(if password
|
||||||
#:real-name real-name
|
(user
|
||||||
#:home-directory
|
(name name)
|
||||||
home-directory)))))))))
|
(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 ()
|
(lambda ()
|
||||||
(destroy-form-and-pop form)))))))
|
(destroy-form-and-pop form)))))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue