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>

1 files changed, 72 insertions, 1 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