diff options
| -rw-r--r-- | gnu/installer/final.scm | 84 | ||||
| -rw-r--r-- | gnu/installer/newt/final.scm | 9 | ||||
| -rw-r--r-- | gnu/installer/newt/user.scm | 21 | ||||
| -rw-r--r-- | gnu/installer/user.scm | 2 |
4 files changed, 103 insertions, 13 deletions
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 07946f72c3..4cf34d0457 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,19 +21,94 @@ #:use-module (gnu installer newt page) #:use-module (gnu installer steps) #:use-module (gnu installer utils) + #:use-module (gnu installer user) #:use-module (gnu services herd) #:use-module (guix build utils) + #:use-module (gnu build accounts) + #:use-module ((gnu system shadow) #:prefix sys:) + #:use-module (rnrs io ports) #:export (install-system)) -(define (install-system locale) - "Start COW-STORE service on target directory and launch guix install command -in a subshell. LOCALE must be the locale name under which that command will -run, or #f." +(define %seed + (seed->random-state + (logxor (getpid) (car (gettimeofday))))) + +(define (integer->alphanumeric-char n) + "Map N, an integer in the [0..62] range, to an alphanumeric character." + (cond ((< n 10) + (integer->char (+ (char->integer #\0) n))) + ((< n 36) + (integer->char (+ (char->integer #\A) (- n 10)))) + ((< n 62) + (integer->char (+ (char->integer #\a) (- n 36)))) + (else + (error "integer out of bounds" n)))) + +(define (random-string len) + "Compute a random string of size LEN where each character is alphanumeric." + (let loop ((chars '()) + (len len)) + (if (zero? len) + (list->string chars) + (let ((n (random 62 %seed))) + (loop (cons (integer->alphanumeric-char n) chars) + (- len 1)))))) + +(define (create-user-database users root) + "Create /etc/passwd, /etc/shadow, and /etc/group under ROOT for the given +USERS." + (define etc + (string-append root "/etc")) + + (define (salt) + ;; "$6" gives us a SHA512 password hash; the random string must be taken + ;; from the './0-9A-Za-z' alphabet (info "(libc) Passphrase Storage"). + (string-append "$6$" (random-string 10))) + + (define users* + (map (lambda (user) + (sys:user-account (name (user-name user)) + (group "users") + (home-directory + (user-home-directory user)) + (password (crypt (user-password user) + (salt))) + + ;; We need a string here, not a file-like, hence + ;; this choice. + (shell + "/run/current-system/profile/bin/bash"))) + users)) + + (define-values (group password shadow) + (user+group-databases users* sys:%base-groups + #:current-passwd '() + #:current-groups '() + #:current-shadow '())) + + (mkdir-p etc) + (write-group group (string-append etc "/group")) + (write-passwd password (string-append etc "/passwd")) + (write-shadow shadow (string-append etc "/shadow"))) + +(define* (install-system locale #:key (users '())) + "Create /etc/shadow and /etc/passwd on the installation target for USERS. +Start COW-STORE service on target directory and launch guix install command in +a subshell. LOCALE must be the locale name under which that command will run, +or #f." (let ((install-command (format #f "guix system init ~a ~a" (%installer-configuration-file) (%installer-target-dir)))) (mkdir-p (%installer-target-dir)) + + ;; We want to initialize user passwords but we don't want to store them in + ;; the config file since the password hashes would end up world-readable + ;; in the store. Thus, create /etc/shadow & co. here such that, on the + ;; first boot, the activation snippet that creates accounts will reuse the + ;; passwords that we've put in there. + (create-user-database users (%installer-target-dir)) + (start-service 'cow-store (list (%installer-target-dir))) (false-if-exception (run-shell-command install-command #:locale locale)))) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index f492c5dbb7..f470a90004 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -65,10 +66,11 @@ press the button to reboot."))) (G_ "The final system installation step failed. You can retry the \ last step, or restart the installer."))) -(define (run-install-shell locale) +(define* (run-install-shell locale + #:key (users '())) (clear-screen) (newt-suspend) - (let ((install-ok? (install-system locale))) + (let ((install-ok? (install-system locale #:users users))) (newt-resume) install-ok?)) @@ -76,12 +78,13 @@ last step, or restart the installer."))) (let* ((configuration (format-configuration prev-steps result)) (user-partitions (result-step result 'partition)) (locale (result-step result 'locale)) + (users (result-step result 'user)) (install-ok? (with-mounted-partitions user-partitions (configuration->file configuration) (run-config-display-page) - (run-install-shell locale)))) + (run-install-shell locale #:users users)))) (if install-ok? (run-install-success-page) (run-install-failed-page)))) diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm index 59b1913cfc..032f9b9276 100644 --- a/gnu/installer/newt/user.scm +++ b/gnu/installer/newt/user.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,10 +37,14 @@ (make-label -1 -1 (pad-label (G_ "Name")))) (label-home-directory (make-label -1 -1 (pad-label (G_ "Home directory")))) + (label-password + (make-label -1 -1 (pad-label (G_ "Password")))) (entry-width 30) (entry-name (make-entry -1 -1 entry-width)) (entry-home-directory (make-entry -1 -1 entry-width)) - (entry-grid (make-grid 2 2)) + (entry-password (make-entry -1 -1 entry-width + #:flags FLAG-PASSWORD)) + (entry-grid (make-grid 3 4)) (button-grid (make-grid 1 1)) (ok-button (make-button -1 -1 (G_ "OK"))) (grid (make-grid 1 2)) @@ -52,6 +57,8 @@ (set-entry-grid-field 1 0 entry-name) (set-entry-grid-field 0 1 label-home-directory) (set-entry-grid-field 1 1 entry-home-directory) + (set-entry-grid-field 0 2 label-password) + (set-entry-grid-field 1 2 entry-password) (set-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button) @@ -62,8 +69,8 @@ (string-append "/home/" (entry-value entry-name))))) (add-components-to-form form - label-name label-home-directory - entry-name entry-home-directory + label-name label-home-directory label-password + entry-name entry-home-directory entry-password ok-button) (make-wrapped-grid-window (vertically-stacked-grid @@ -82,8 +89,9 @@ (when (eq? exit-reason 'exit-component) (cond ((components=? argument ok-button) - (let ((name (entry-value entry-name)) - (home-directory (entry-value entry-home-directory))) + (let ((name (entry-value entry-name)) + (home-directory (entry-value entry-home-directory)) + (password (entry-value entry-password))) (if (or (string=? name "") (string=? home-directory "")) (begin @@ -91,7 +99,8 @@ (run-user-add-page)) (user (name name) - (home-directory home-directory)))))))) + (home-directory home-directory) + (password password)))))))) (lambda () (destroy-form-and-pop form))))))) diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm index 1f8d40a011..fe755ad2c6 100644 --- a/gnu/installer/user.scm +++ b/gnu/installer/user.scm @@ -24,6 +24,7 @@ user-name user-group user-home-directory + user-password users->configuration)) @@ -33,6 +34,7 @@ (name user-name) (group user-group (default "users")) + (password user-password) (home-directory user-home-directory)) (define (users->configuration users) |