Re: KMScon vs. AMD Radeon

[Mathieu Othacehe <m.othacehe@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 329 bytes --]


Hello,

> On Guix System 0.16 the directory /sys/class/drm contains only
> ttm and version.

Ok, thanks for testing.

Here's a patch that fallback to mingetty if kmscon is not supported. I
don't have a machine with AMD GPU for testing so if Florian or Pierre
could test the patch that would be very helpful :)

Thanks,

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-wip-Fallback-to-mingetty-if-kmscon-is-not-supported.patch --]
[-- Type: text/x-diff, Size: 14598 bytes --]

From f728749dc02f8bb8a1870925547d96d8ce352f55 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
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 <https://bugs.gnu.org/27155>.  Keep it internal/undocumented
+  ;; for now.
+  (%auto-start?   mingetty-auto-start?
+                  (default #t)))
 
 (define mingetty-shepherd-service
   (match-lambda
     (($ <mingetty-configuration> 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 <https://bugs.gnu.org/27155>.  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>
   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