diff options
-rw-r--r-- | gnu/installer/build-installer.scm | 34 | ||||
-rw-r--r-- | gnu/system/install.scm | 245 |
2 files changed, 160 insertions, 119 deletions
diff --git a/gnu/installer/build-installer.scm b/gnu/installer/build-installer.scm index 1a084bc3dc..c7f439b35f 100644 --- a/gnu/installer/build-installer.scm +++ b/gnu/installer/build-installer.scm @@ -37,7 +37,8 @@ #:use-module (gnu packages xorg) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:export (installer-program)) + #:export (installer-program + installer-program-launcher)) (define not-config? ;; Select (guix …) and (gnu …) modules, except (guix config). @@ -288,3 +289,34 @@ selected keymap." #$(installer-exit installer))))) (program-file "installer" installer-builder)) + +;; We want the installer to honor the LANG environment variable, so that the +;; locale is correctly installed when the installer is launched, and the +;; welcome page is possibly translated. The /etc/environment file (containing +;; LANG) is supposed to be loaded using PAM by the login program. As the +;; installer replaces the login program, read this file and set all the +;; variables it contains before starting the installer. This is a dirty hack, +;; we might want to find a better way to do it in the future. +(define (installer-program-launcher installer) + "Return a file-like object that set the variables in /etc/environment and +run the given INSTALLER." + (define load-environment + #~(call-with-input-file "/etc/environment" + (lambda (port) + (let ((lines (read-lines port))) + (map (lambda (line) + (match (string-split line #\=) + ((name value) + (setenv name value)))) + lines))))) + + (define wrapper + (with-imported-modules '((gnu installer utils)) + #~(begin + (use-modules (gnu installer utils) + (ice-9 match)) + + #$load-environment + (system #$(installer-program installer))))) + + (program-file "installer-launcher" wrapper)) diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 05f3795b81..aef083506c 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -209,114 +209,128 @@ the user's target storage device rather than on the RAM disk." (persistent? #f) (max-database-size (* 5 (expt 2 20)))))) ;5 MiB -(define (normal-tty tty) - (service kmscon-service-type - (kmscon-configuration - (virtual-terminal tty) - (auto-login "root")))) - -(define bare-bones-os - (load "examples/bare-bones.tmpl")) - (define %installation-services ;; List of services of the installation system. - (list (login-service (login-configuration - ;; The motd is overlapped by the graphical installer, - ;; so make sure it is not printed. - (motd #f))) - - ;; This will be the active virtual terminal at boot. The graphical - ;; installer is launched as the 'shell' program of the root - ;; user-account. Thanks to auto-login, it will be started - ;; automatically. Another option would have been to set the graphical - ;; installer as a login program. However, it is preferable to wait - ;; for the login phase to be over, so that the environnment variables - ;; of /etc/environment like LANG are loaded by PAM. - (normal-tty "tty1") - - ;; Documentation. - (service kmscon-service-type - (kmscon-configuration - (virtual-terminal "tty2") - (login-program (log-to-info)) - (auto-login "guest"))) - - ;; Documentation add-on. - %configuration-template-service - - ;; A bunch of 'root' ttys. - (normal-tty "tty3") - (normal-tty "tty4") - (normal-tty "tty5") - (normal-tty "tty6") - - ;; The usual services. - (syslog-service) - - ;; The build daemon. Register the hydra.gnu.org key as trusted. - ;; This allows the installation process to use substitutes by - ;; default. - (service guix-service-type - (guix-configuration (authorize-key? #t))) - - ;; Start udev so that useful device nodes are available. - ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for - ;; regulations-compliant WiFi access. - (udev-service #:rules (list lvm2 crda)) - - ;; Add the 'cow-store' service, which users have to start manually - ;; since it takes the installation directory as an argument. - (cow-store-service) - - ;; To facilitate copy/paste. - (service gpm-service-type) - - ;; Add an SSH server to facilitate remote installs. - (service openssh-service-type - (openssh-configuration - (port-number 22) - (permit-root-login #t) - ;; The root account is passwordless, so make sure - ;; a password is set before allowing logins. - (allow-empty-passwords? #f) - (password-authentication? #t) - - ;; Don't start it upfront. - (%auto-start? #f))) - - ;; Since this is running on a USB stick with a overlayfs as the root - ;; file system, use an appropriate cache configuration. - (nscd-service (nscd-configuration - (caches %nscd-minimal-caches))) - - ;; Having /bin/sh is a good idea. In particular it allows Tramp - ;; connections to this system to work. - (service special-files-service-type - `(("/bin/sh" ,(file-append (canonical-package bash) - "/bin/sh")))) - - ;; Loopback device, needed by OpenSSH notably. - (service static-networking-service-type - (list (static-networking (interface "lo") - (ip "127.0.0.1") - (requirement '()) - (provision '(loopback))))) - - (service wpa-supplicant-service-type) - (dbus-service) - (service connman-service-type - (connman-configuration - (disable-vpn? #t))) - - ;; Keep a reference to BARE-BONES-OS to make sure it can be - ;; installed without downloading/building anything. Also keep the - ;; things needed by 'profile-derivation' to minimize the amount of - ;; download. - (service gc-root-service-type - (list bare-bones-os - glibc-utf8-locales - texinfo - (canonical-package guile-2.2))))) + (let ((motd (plain-file "motd" " +\x1b[1;37mWelcome to the installation of the Guix System Distribution!\x1b[0m + +\x1b[2mThere is NO WARRANTY, to the extent permitted by law. In particular, you may +LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore, +it is 'beta' software, so it may contain bugs. + +You have been warned. Thanks for being so brave.\x1b[0m +"))) + (define (normal-tty tty) + (mingetty-service (mingetty-configuration (tty tty) + (auto-login "root") + (login-pause? #t)))) + + (define bare-bones-os + (load "examples/bare-bones.tmpl")) + + (list (service virtual-terminal-service-type) + + (service kmscon-service-type + (kmscon-configuration + (virtual-terminal "tty1") + (login-program (installer-program-launcher + newt-installer)))) + + (login-service (login-configuration + (motd motd))) + + ;; Documentation. The manual is in UTF-8, but + ;; 'console-font-service' sets up Unicode support and loads a font + ;; with all the useful glyphs like em dash and quotation marks. + (mingetty-service (mingetty-configuration + (tty "tty2") + (auto-login "guest") + (login-program (log-to-info)))) + + ;; Documentation add-on. + %configuration-template-service + + ;; A bunch of 'root' ttys. + (normal-tty "tty3") + (normal-tty "tty4") + (normal-tty "tty5") + (normal-tty "tty6") + + ;; The usual services. + (syslog-service) + + ;; The build daemon. Register the hydra.gnu.org key as trusted. + ;; This allows the installation process to use substitutes by + ;; default. + (service guix-service-type + (guix-configuration (authorize-key? #t))) + + ;; Start udev so that useful device nodes are available. + ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for + ;; regulations-compliant WiFi access. + (udev-service #:rules (list lvm2 crda)) + + ;; Add the 'cow-store' service, which users have to start manually + ;; since it takes the installation directory as an argument. + (cow-store-service) + + ;; Install Unicode support and a suitable font. Use a font that + ;; doesn't have more than 256 glyphs so that we can use colors with + ;; varying brightness levels (see note in setfont(8)). + (service console-font-service-type + (map (lambda (tty) + (cons tty "lat9u-16")) + '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) + + ;; To facilitate copy/paste. + (service gpm-service-type) + + ;; Add an SSH server to facilitate remote installs. + (service openssh-service-type + (openssh-configuration + (port-number 22) + (permit-root-login #t) + ;; The root account is passwordless, so make sure + ;; a password is set before allowing logins. + (allow-empty-passwords? #f) + (password-authentication? #t) + + ;; Don't start it upfront. + (%auto-start? #f))) + + ;; Since this is running on a USB stick with a overlayfs as the root + ;; file system, use an appropriate cache configuration. + (nscd-service (nscd-configuration + (caches %nscd-minimal-caches))) + + ;; Having /bin/sh is a good idea. In particular it allows Tramp + ;; connections to this system to work. + (service special-files-service-type + `(("/bin/sh" ,(file-append (canonical-package bash) + "/bin/sh")))) + + ;; Loopback device, needed by OpenSSH notably. + (service static-networking-service-type + (list (static-networking (interface "lo") + (ip "127.0.0.1") + (requirement '()) + (provision '(loopback))))) + + (service wpa-supplicant-service-type) + (dbus-service) + (service connman-service-type + (connman-configuration + (disable-vpn? #t))) + + ;; Keep a reference to BARE-BONES-OS to make sure it can be + ;; installed without downloading/building anything. Also keep the + ;; things needed by 'profile-derivation' to minimize the amount of + ;; download. + (service gc-root-service-type + (list bare-bones-os + glibc-utf8-locales + texinfo + (canonical-package guile-2.2)))))) (define %issue ;; Greeting. @@ -361,18 +375,13 @@ the user's target storage device rather than on the RAM disk." %shared-memory-file-system %immutable-store))) - (users (list - (user-account - (inherit %root-account) - ;; Launch the graphical installer. - (shell (installer-program newt-installer))) - (user-account - (name "guest") - (group "users") - (supplementary-groups '("wheel")) ; allow use of sudo - (password "") - (comment "Guest of GNU") - (home-directory "/home/guest")))) + (users (list (user-account + (name "guest") + (group "users") + (supplementary-groups '("wheel")) ; allow use of sudo + (password "") + (comment "Guest of GNU") + (home-directory "/home/guest")))) (issue %issue) (services %installation-services) |