unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Danny Milosavljevic <dannym@scratchpost.org>
To: 30216@debbugs.gnu.org
Subject: [bug#30216] [WIP v2] services: agetty: Make tty optional.
Date: Tue, 23 Jan 2018 15:34:09 +0100	[thread overview]
Message-ID: <20180123143409.31064-1-dannym@scratchpost.org> (raw)
In-Reply-To: <20180122232643.22408-1-dannym@scratchpost.org>

* gnu/services/base.scm (default-tty): New variable.
(agetty-shepherd-service): Make tty optional, default to the above.
* gnu/system/install.scm (arm-installation-os): New variable.  Use the above.
---
 gnu/services/base.scm  | 45 ++++++++++++++++++++++++++++++++++++++++++---
 gnu/system/install.scm |  8 +++++++-
 2 files changed, 49 insertions(+), 4 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 8e30bcd34..3874c22b8 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,42 @@ 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 (ice-9 textual-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 car (string-tokenize console-ttys not-comma)))))
+        (if (null? ttys)
+          "XXX"
+          (car ttys)))))
+
 (define agetty-shepherd-service
   (match-lambda
     (($ <agetty-configuration> agetty tty term baud-rate auto-login
@@ -901,7 +937,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 +982,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 +1048,7 @@ the message of the day, among other things."
                           #$@(if login-pause?
                                  #~("--login-pause")
                                  #~())
-                          #$tty
+                          #$(or tty (default-tty))
                           #$@(if baud-rate
                                  #~(#$baud-rate)
                                  #~())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index e4b2e8237..cde30ec3b 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -47,6 +47,7 @@
             a20-olinuxino-lime-installation-os
             a20-olinuxino-lime2-emmc-installation-os
             a20-olinuxino-micro-installation-os
+            arm-installation-os
             banana-pi-m2-ultra-installation-os
             beaglebone-black-installation-os
             nintendo-nes-classic-edition-installation-os))
@@ -381,7 +382,7 @@ You have been warned.  Thanks for being so brave.\x1b[0m
                      nvi                          ;:wq!
                      %base-packages))))
 
-(define* (agetty-default-service #:optional (tty "ttyS0"))
+(define* (agetty-default-service #:optional (tty #f))
   "Return an agetty-service on the given TTY"
   (agetty-service (agetty-configuration
                    (extra-options '("-L"))
@@ -408,6 +409,11 @@ The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
     (services (cons* (agetty-default-service tty)
                      (operating-system-user-services installation-os)))))
 
+(define arm-installation-os
+  (embedded-installation-os u-boot-bootloader
+                            "/dev/null"
+                            #f))
+
 (define beaglebone-black-installation-os
   (embedded-installation-os u-boot-beaglebone-black-bootloader
                             "/dev/sda"

  reply	other threads:[~2018-01-23 14:35 UTC|newest]

Thread overview: 15+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2018-01-22 22:00 [bug#30216] [FIXME] system: Add ARM installer Danny Milosavljevic
2018-01-22 23:26 ` [bug#30216] [WIP] services: agetty: Make tty optional Danny Milosavljevic
2018-01-23 14:34   ` Danny Milosavljevic [this message]
2018-01-23 14:40     ` [bug#30216] [WIP v3] " Danny Milosavljevic
2018-01-24 13:12       ` [bug#30216] [WIP v4] " Danny Milosavljevic
2018-01-24 13:31         ` [bug#30216] [WIP v5] " Danny Milosavljevic
2018-01-30 20:56           ` Ludovic Courtès
2018-01-30 23:24             ` Danny Milosavljevic
2018-01-30 23:30             ` Danny Milosavljevic
2018-01-31  9:09               ` Ludovic Courtès
2018-01-23 11:39 ` [bug#30216] [FIXME] system: Add ARM installer Ludovic Courtès
2018-01-23 13:54   ` [bug#30216] [WIP] system: Add ARM installer; services: agetty: Make tty optional Danny Milosavljevic
2018-01-25 14:56     ` Ludovic Courtès
2018-01-25 22:33       ` Danny Milosavljevic
2018-01-26 10:36         ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20180123143409.31064-1-dannym@scratchpost.org \
    --to=dannym@scratchpost.org \
    --cc=30216@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).