diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-04-28 16:24:46 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-04-28 16:24:46 +0200 |
commit | 284fa7264963acc5d114ef5d54c347126b1654ba (patch) | |
tree | 3e5360fcc81b6d0dce76a65aca60cf8528f2931f /gnu/installer/newt/user.scm | |
parent | 12c9da35389dfba86ae0d863132a6b2c4374205a (diff) | |
parent | 882cacc1bb5be0df334dd7ce55b385a3a1678728 (diff) | |
download | guix-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.scm | 49 |
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))))))) |