installer: Ask for the root account password.
Fixes <https://bugs.gnu.org/35399>. * gnu/installer/newt/user.scm (run-root-password-page): New procedure. * gnu/installer/user.scm (users->configuration): Filter out the "root" account. * gnu/installer/final.scm (create-user-database): Set 'uid' field in 'user-account' form.
This commit is contained in:
parent
399c31d40a
commit
91a7c4998f
|
@ -67,8 +67,12 @@ USERS."
|
|||
|
||||
(define users*
|
||||
(map (lambda (user)
|
||||
(define root?
|
||||
(string=? "root" (user-name user)))
|
||||
|
||||
(sys:user-account (name (user-name user))
|
||||
(group "users")
|
||||
(uid (if root? 0 #f))
|
||||
(home-directory
|
||||
(user-home-directory user))
|
||||
(password (crypt (user-password user)
|
||||
|
|
|
@ -104,6 +104,14 @@
|
|||
(lambda ()
|
||||
(destroy-form-and-pop form)))))))
|
||||
|
||||
(define (run-root-password-page)
|
||||
;; TRANSLATORS: Leave "root" untranslated: it refers to the name of the
|
||||
;; system administrator account.
|
||||
(run-input-page (G_ "Please choose a password for the system \
|
||||
administrator (\"root\").")
|
||||
(G_ "System administrator password")
|
||||
#:input-flags FLAG-PASSWORD))
|
||||
|
||||
(define (run-user-page)
|
||||
(define (run users)
|
||||
(let* ((listbox (make-listbox
|
||||
|
@ -181,4 +189,9 @@
|
|||
users))))
|
||||
(lambda ()
|
||||
(destroy-form-and-pop form))))))
|
||||
(run '()))
|
||||
|
||||
;; Add a "root" user simply to convey the root password.
|
||||
(cons (user (name "root")
|
||||
(home-directory "/root")
|
||||
(password (run-root-password-page)))
|
||||
(run '())))
|
||||
|
|
|
@ -18,6 +18,7 @@
|
|||
|
||||
(define-module (gnu installer user)
|
||||
#:use-module (guix records)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (<user>
|
||||
user
|
||||
make-user
|
||||
|
@ -39,14 +40,18 @@
|
|||
|
||||
(define (users->configuration users)
|
||||
"Return the configuration field for USERS."
|
||||
(define (user->sexp user)
|
||||
`(user-account
|
||||
(name ,(user-name user))
|
||||
(group ,(user-group user))
|
||||
(home-directory ,(user-home-directory user))
|
||||
(supplementary-groups '("wheel" "netdev"
|
||||
"audio" "video"))))
|
||||
|
||||
`((users (cons*
|
||||
,@(map (lambda (user)
|
||||
`(user-account
|
||||
(name ,(user-name user))
|
||||
(group ,(user-group user))
|
||||
(home-directory ,(user-home-directory user))
|
||||
(supplementary-groups
|
||||
(quote ("wheel" "netdev"
|
||||
"audio" "video")))))
|
||||
users)
|
||||
%base-user-accounts))))
|
||||
,@(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))))
|
||||
|
|
Loading…
Reference in New Issue