[bug#30216] [WIP v5] services: agetty: Make tty optional.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/system/install.scm (agetty-default-service): Delete variable.
(beaglebone-black-installation-os): Do not specify tty.
(a20-olinuxino-lime-installation-os): Do not specify tty.
(a20-olinuxino-lime2-emmc-installation-os): Do not specify tty.
(a20-olinuxino-micro-installation-os): Do not specify tty.
(banana-pi-m2-ultra-installation-os): Do not specify tty.
(nintendo-nes-classic-edition-installation-os): Do not specify tty.
(embedded-installation-os): Move agetty-service instantiation to...
* gnu/services/base.scm (%base-services): ...here.
(default-tty): New variable.
(agetty-shepherd-service): Make tty optional, default to the above.
---
 gnu/services/base.scm  | 54 +++++++++++++++++++++++++++++++++++++++++++++++---
 gnu/system/install.scm | 37 +++++++++++-----------------------
 2 files changed, 63 insertions(+), 28 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 8e30bcd34..e8c0240bf 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -817,7 +817,7 @@ the message of the day, among other things."
   agetty-configuration?
   (agetty           agetty-configuration-agetty   ;<package>
                     (default util-linux))
-  (tty              agetty-configuration-tty)     ;string
+  (tty              agetty-configuration-tty)     ;string | #f
   (term             agetty-term                   ;string | #f
                     (default #f))
   (baud-rate        agetty-baud-rate              ;string | #f
@@ -890,6 +890,46 @@ the message of the day, among other things."
 ;;;                 (default #f))
   )
 
+(define (default-tty)
+  #~(begin
+      ;; console=device,options
+      ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial).
+      ;; options: BBBBPNF. P n|o|e, N number of bits,
+      ;; F flow control (r RTS)
+      (use-modules (rnrs io ports))
+      (let* ((command (call-with-input-file "/proc/cmdline" get-string-all))
+             (not-comma (char-set-complement (char-set #\,)))
+             (items (string-tokenize command))
+             (items-by-key (lambda (key target-prefix)
+                            (let ((keylen (string-length key)))
+                              (map (lambda (a)
+                                     (string-append target-prefix
+                                                    (string-drop a keylen)))
+                                   (filter (lambda (b)
+                                             (string-prefix? key b)) items)))))
+             (agetty-ttys (items-by-key "agetty.tty=" ""))
+             (console-ttys (filter (lambda (tty)
+                                     (not (or
+                                            (string-prefix? tty "tty0")
+                                            (string-prefix? tty "tty1")
+                                            (string-prefix? tty "tty2")
+                                            (string-prefix? tty "tty3")
+                                            (string-prefix? tty "tty4")
+                                            (string-prefix? tty "tty5")
+                                            (string-prefix? tty "tty6")
+                                            (string-prefix? tty "tty7")
+                                            (string-prefix? tty "tty8")
+                                            (string-prefix? tty "tty9"))))
+                                   (items-by-key "console=tty" "tty")))
+             (ttys (or agetty-ttys (map (lambda (console-spec)
+                                          ;; Extract device name.
+                                          (car (string-tokenize console-spec
+                                                                not-comma)))
+                                        console-ttys))))
+        (if (null? ttys)
+          "XXX" ; would crash entire boot process: (error "agetty: No default tty found.")
+          (car ttys)))))
+
 (define agetty-shepherd-service
   (match-lambda
     (($ <agetty-configuration> agetty tty term baud-rate auto-login
@@ -901,7 +941,7 @@ the message of the day, among other things."
      (list
        (shepherd-service
          (documentation "Run agetty on a tty.")
-         (provision (list (symbol-append 'term- (string->symbol tty))))
+         (provision (list (symbol-append 'term- (string->symbol (or tty "auto")))))
 
          ;; Since the login prompt shows the host name, wait for the 'host-name'
          ;; service to be done.  Also wait for udev essentially so that the tty
@@ -946,6 +986,9 @@ the message of the day, among other things."
                                         ('always "--local-line=always")
                                         ('never "-local-line=never")))
                                  #~())
+                          #$@(if tty
+                                 #~()
+                                 #~("--keep-baud"))
                           #$@(if extract-baud?
                                  #~("--extract-baud")
                                  #~())
@@ -1009,7 +1052,7 @@ the message of the day, among other things."
                           #$@(if login-pause?
                                  #~("--login-pause")
                                  #~())
-                          #$tty
+                          #$(or tty (default-tty))
                           #$@(if baud-rate
                                  #~(#$baud-rate)
                                  #~())
@@ -2012,6 +2055,11 @@ This service is not part of @var{%base-services}."
                         (cons tty %default-console-font))
                       '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
 
+        (agetty-service (agetty-configuration
+                         (extra-options '("-L")) ; no carrier detect
+                         (term "vt100")
+                         (tty #f))) ; automatic
+
         (mingetty-service (mingetty-configuration
                            (tty "tty1")))
         (mingetty-service (mingetty-configuration
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index e4b2e8237..db06b7a52 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -381,19 +381,10 @@ You have been warned.  Thanks for being so brave.\x1b[0m
                      nvi                          ;:wq!
                      %base-packages))))
 
-(define* (agetty-default-service #:optional (tty "ttyS0"))
-  "Return an agetty-service on the given TTY"
-  (agetty-service (agetty-configuration
-                   (extra-options '("-L"))
-                   (baud-rate "115200")
-                   (term "vt100")
-                   (tty tty))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
+(define* (embedded-installation-os bootloader bootloader-target
                                    #:key (extra-modules '()))
   "Return an installation os for embedded systems.
 The initrd gets the extra modules EXTRA-MODULES.
-A getty is provided on TTY.
 The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
   (operating-system
     (inherit installation-os)
@@ -404,43 +395,39 @@ The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
     (initrd (lambda (fs . rest)
               (apply base-initrd fs
                      #:extra-modules extra-modules
-                     rest)))
-    (services (cons* (agetty-default-service tty)
-                     (operating-system-user-services installation-os)))))
+                     rest)))))
 
 (define beaglebone-black-installation-os
   (embedded-installation-os u-boot-beaglebone-black-bootloader
                             "/dev/sda"
-                            "ttyO0"
                             #:extra-modules
                             ;; This module is required to mount the sd card.
                             '("omap_hsmmc")))
 
-
 (define a20-olinuxino-lime-installation-os
   (embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
-                            "/dev/mmcblk0" ; SD card storage
-                            "ttyS0"))
+                            ;; SD card storage
+                            "/dev/mmcblk0"))
 
 (define a20-olinuxino-lime2-emmc-installation-os
   (embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
-                            "/dev/mmcblk1" ; eMMC storage
-                            "ttyS0"))
+                            ;; eMMC storage
+                            "/dev/mmcblk1"))
 
 (define a20-olinuxino-micro-installation-os
   (embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
-                            "/dev/mmcblk0" ; SD card storage
-                            "ttyS0"))
+                            ;; SD card storage
+                            "/dev/mmcblk0"))
 
 (define banana-pi-m2-ultra-installation-os
   (embedded-installation-os u-boot-banana-pi-m2-ultra-bootloader
-                            "/dev/mmcblk1" ; eMMC storage
-                            "ttyS0"))
+                            ;; eMMC storage
+                            "/dev/mmcblk1"))
 
 (define nintendo-nes-classic-edition-installation-os
   (embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
-                            "/dev/mmcblk0" ; SD card (solder it yourself)
-                            "ttyS0"))
+                            ;; SD card storage (solder it yourself)
+                            "/dev/mmcblk0"))
 
 ;; Return the default os here so 'guix system' can consume it directly.
 installation-os