summaryrefslogtreecommitdiff
path: root/gnu/installer/newt/user.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-04-28 16:24:46 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-28 16:24:46 +0200
commit284fa7264963acc5d114ef5d54c347126b1654ba (patch)
tree3e5360fcc81b6d0dce76a65aca60cf8528f2931f /gnu/installer/newt/user.scm
parent12c9da35389dfba86ae0d863132a6b2c4374205a (diff)
parent882cacc1bb5be0df334dd7ce55b385a3a1678728 (diff)
downloadguix-patches-284fa7264963acc5d114ef5d54c347126b1654ba.tar
guix-patches-284fa7264963acc5d114ef5d54c347126b1654ba.tar.gz
Merge branch 'master' into staging
Diffstat (limited to 'gnu/installer/newt/user.scm')
-rw-r--r--gnu/installer/newt/user.scm49
1 files changed, 31 insertions, 18 deletions
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)))))))