install: Register agetty on primary console on AArch64.

This adds the possibility to parse /proc/consoles to find a primary console.
Then, on AArch64 this is used in the installation image. On AArch64, the boot
usually happens with chosen device tree that contains the serial console.
On x86_64, this does not happen so often, so we keep the installation iso
minimal there.

The primary console is chosen, but there is a fallback to any non-virtual one.
Virtual console (/dev/tty0) is skipped, because that one can point to any
console, like /dev/tty1 and so on. So it's not safe to register agetty on it.

* gnu/build/linux-boot.scm (read-linux-consoles): New variable.
* gnu/services/base.scm (default-serial-console): Use primary console as
fallback.
* gnu/system/install.scm (%installation-services): Add agetty tty for
consoles.

Change-Id: Iae01f7bc85b5ffdef2e52b1d0710889915b0f54a
Signed-off-by: Rutherther <rutherther@ditigal.xyz>

3 files changed, 102 insertions, 3 deletions

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 61fa6716dba..e0743eae55a 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -46,7 +46,26 @@
             make-static-device-nodes
             configure-qemu-networking
 
-            boot-system))
+            boot-system
+
+            linux-console
+
+            linux-console?
+            linux-console-device
+            linux-console-can-read?
+            linux-console-can-write?
+            linux-console-can-unblank?
+            linux-console-enabled?
+            linux-console-preferred?
+            linux-console-primary?
+            linux-console-printk?
+            linux-console-braille?
+            linux-console-safe-when-cpu-offline?
+            linux-console-major
+            linux-console-minor
+            linux-console-virtual?
+
+            read-linux-consoles))
 
 ;;; Commentary:
 ;;;
@@ -675,4 +694,56 @@ the root file system...\n" root-delay)
               (start-repl)))))
     #:on-error on-error))
 
+(define-record-type <linux-console>
+  (make-linux-console device can-read? can-write? can-unblank?
+                      enabled? preferred? primary? printk? braille?
+                      safe-when-cpu-offline? major minor virtual?)
+  linux-console?
+  (device linux-console-device)
+  (can-read? linux-console-can-read?)
+  (can-write? linux-console-can-write?)
+  (can-unblank? linux-console-can-unblank?)
+  (enabled? linux-console-enabled?)
+  (preferred? linux-console-preferred?)
+  (primary? linux-console-primary?)
+  (printk? linux-console-printk?)
+  (braille? linux-console-braille?)
+  (safe-when-cpu-offline? linux-console-safe-when-cpu-offline?)
+  (major linux-console-major)
+  (minor linux-console-minor)
+  (virtual? linux-console-virtual?))
+
+(define* (read-linux-consoles #:optional (consoles-file "/proc/consoles"))
+  "Parses CONSOLES-FILE and returns a list of <linux-console> records."
+  (if (not (file-exists? consoles-file))
+      '()
+      (with-input-from-file consoles-file
+        (lambda ()
+          (let ((line-regex (make-regexp
+                             "^([^ ]+)[ ]+(.+)[ ]+([0-9]+):([0-9]+)$"))
+                (virt-regex (make-regexp "^tty[0-9]+$")))
+            (let loop ((line (read-line))
+                       (results '()))
+              (cond
+               ((eof-object? line)
+                (reverse results))
+               ((regexp-exec line-regex line)
+                => (lambda (m)
+                     (let* ((dev      (match:substring m 1))
+                            (flags    (match:substring m 2))
+                            (major    (string->number (match:substring m 3)))
+                            (minor    (string->number (match:substring m 4)))
+                            (virtual? (regexp-exec virt-regex dev))
+                            (has?     (lambda (c)
+                                      (string-any (lambda (f) (char=? f c)) flags))))
+                       (loop (read-line)
+                             (cons (make-linux-console
+                                    dev
+                                    (has? #\R) (has? #\W) (has? #\U) (has? #\E)
+                                    (has? #\C) (has? #\B) (has? #\p) (has? #\b)
+                                    (has? #\a)
+                                    major minor virtual?)
+                                   results)))))
+               (else (loop (read-line) results)))))))))
+
 ;;; linux-boot.scm ends here
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 4a4f1d17c18..850b651b9a3 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1060,6 +1060,9 @@ to use as the tty.  This is primarily useful for headless systems."
   (with-imported-modules (source-module-closure
                           '((gnu build linux-boot))) ;for 'find-long-options'
     #~(begin
+        (use-modules (gnu build linux-boot)
+                     (srfi srfi-1))
+
         ;; console=device,options
         ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial).
         ;; options: BBBBPNF. P n|o|e, N number of bits,
@@ -1083,7 +1086,20 @@ to use as the tty.  This is primarily useful for headless systems."
                                       (find-long-options "console" command)))
                (specs (append agetty-specs console-specs)))
           (match specs
-            (() #f)
+            ;; Fallback to a physical console registered in /proc/consoles.
+            (() (let* ((consoles (read-linux-consoles))
+                       (chosen-console
+                        ;; Prioritize preferred, if none, choose any enabled.
+                        (or (find (lambda (c)
+                                    (and (not (linux-console-virtual? c))
+                                         (linux-console-preferred? c)))
+                                  consoles)
+                            (find (lambda (c)
+                                    (and (not (linux-console-virtual? c))
+                                         (linux-console-enabled? c)))
+                                  consoles))))
+                  (and chosen-console
+                       (linux-console-device chosen-console))))
             ((spec _ ...)
              ;; Extract device name from first spec.
              (match (string-tokenize spec not-comma)
@@ -1111,7 +1127,8 @@ to use as the tty.  This is primarily useful for headless systems."
       (requirement (cons* 'user-processes 'host-name 'udev
                           shepherd-requirement))
 
-      (modules '((ice-9 match) (gnu build linux-boot)))
+      (modules '((ice-9 match) (gnu build linux-boot)
+                 (srfi srfi-1)))
       (start
        (with-imported-modules  (source-module-closure
                                 '((gnu build linux-boot)))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index e5dfdbb427b..80332b7b534 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -483,6 +483,17 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
 
      ;; Specific system services
 
+     ;; AArch64 has a better detection of consoles, mainly because device
+     ;; trees are utilized.  On x86_64, the detection is usually done
+     ;; through BIOS and consoles do not get registered to /proc/console.
+     ;; The only way they would is if the user used console linux argument.
+     `(,@(if (target-aarch64? system)
+             (list (service agetty-service-type
+                            (agetty-configuration (tty #f)
+                                                  (auto-login "root")
+                                                  (login-pause? #t))))
+             '()))
+
      ;; Machines without Kernel Mode Setting (those with many old and
      ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI
      ;; installer.  Some may also need a kernel parameter like nomodeset