From f728749dc02f8bb8a1870925547d96d8ce352f55 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 1 Apr 2019 15:54:26 +0200 Subject: [PATCH] wip: Fallback to mingetty if kmscon is not supported. --- gnu/services/base.scm | 29 +++-- gnu/system/install.scm | 240 +++++++++++++++++++++++------------------ 2 files changed, 160 insertions(+), 109 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 04b123b833..fde2cdbcfb 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1105,12 +1105,18 @@ the tty to run, among other things." (login-program mingetty-login-program ;gexp (default #f)) (login-pause? mingetty-login-pause? ;Boolean - (default #f))) + (default #f)) + ;; Boolean + ;; XXX: This should really be handled in an orthogonal way, for instance as + ;; proposed in . Keep it internal/undocumented + ;; for now. + (%auto-start? mingetty-auto-start? + (default #t))) (define mingetty-shepherd-service (match-lambda (($ mingetty tty auto-login login-program - login-pause?) + login-pause? %auto-start?) (list (shepherd-service (documentation "Run mingetty on an tty.") @@ -1140,7 +1146,8 @@ the tty to run, among other things." #$@(if login-pause? #~("--loginpause") #~())))) - (stop #~(make-kill-destructor))))))) + (stop #~(make-kill-destructor)) + (auto-start? %auto-start?)))))) (define mingetty-service-type (service-type (name 'mingetty) @@ -2146,7 +2153,13 @@ This service is not part of @var{%base-services}." (auto-login kmscon-configuration-auto-login (default #f)) (hardware-acceleration? kmscon-configuration-hardware-acceleration? - (default #f))) ; #t causes failure + (default #f)) ; #t causes failure + ;; Boolean + ;; XXX: This should really be handled in an orthogonal way, for instance as + ;; proposed in . Keep it internal/undocumented + ;; for now. + (%auto-start? kmscon-configuration-auto-start? + (default #t))) (define kmscon-service-type (shepherd-service-type @@ -2157,7 +2170,8 @@ This service is not part of @var{%base-services}." (login-program (kmscon-configuration-login-program config)) (login-arguments (kmscon-configuration-login-arguments config)) (auto-login (kmscon-configuration-auto-login config)) - (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config))) + (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config)) + (auto-start? (kmscon-configuration-auto-start? config))) (define kmscon-command #~(list @@ -2174,9 +2188,10 @@ This service is not part of @var{%base-services}." (shepherd-service (documentation "kmscon virtual terminal") (requirement '(user-processes udev dbus-system)) - (provision (list (symbol-append 'term- (string->symbol virtual-terminal)))) + (provision (list (symbol-append 'kmscon- (string->symbol virtual-terminal)))) (start #~(make-forkexec-constructor #$kmscon-command)) - (stop #~(make-kill-destructor))))))) + (stop #~(make-kill-destructor)) + (auto-start? auto-start?)))))) (define-record-type* static-networking make-static-networking diff --git a/gnu/system/install.scm b/gnu/system/install.scm index aad1deb913..b9c58691d4 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -209,6 +209,45 @@ the user's target storage device rather than on the RAM disk." (persistent? #f) (max-database-size (* 5 (expt 2 20)))))) ;5 MiB +(define (installer-services) + (define is-kmscon-supported? + #~(let ((drm-regex (make-regexp "(card|render).*$"))) + (not (null? (scandir "/sys/class/drm" + (cut regexp-exec drm-regex <>)))))) + + (let ((mingetty + (service mingetty-service-type + (mingetty-configuration + (tty "tty1") + (auto-login "root") + (%auto-start? #f)))) + (kmscon + (service kmscon-service-type + (kmscon-configuration + (virtual-terminal "tty1") + (login-program (installer-program)) + (%auto-start? #f))))) + (list + mingetty + kmscon + (service + (shepherd-service-type + 'installer-tty + (lambda _ + (shepherd-service + (provision '(installer-tty)) + (requirement '(user-processes host-name udev virtual-terminal)) + (start #~(lambda _ + (if #$is-kmscon-supported? + (start 'kmscon-tty1) + (start 'term-tty1)))) + (stop #~(make-kill-destructor)) + (modules `((ice-9 ftw) + (ice-9 regex) + (srfi srfi-26) + ,@%default-modules))))) + '())))) + (define %installation-services ;; List of services of the installation system. (let ((motd (plain-file "motd" " @@ -228,108 +267,105 @@ You have been warned. Thanks for being so brave.\x1b[0m (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)))) - - (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)))))) + (append + (installer-services) + (list (service virtual-terminal-service-type) + + (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. -- 2.17.1