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:
Ludovic Courtès 2019-04-24 21:54:28 +02:00
parent 399c31d40a
commit 91a7c4998f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 33 additions and 11 deletions

View File

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

View File

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

View File

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