services: Add agetty service.

* gnu/services/base.scm (<agetty-configuration>): New record type.
(agetty-shepherd-service, agetty-service): New procedures.
(agetty-service-type): New variable.
* doc/guix.texi (Base Services): Document it.
[mingetty-configuration],[kmscon-configuration]: Specify the types of
supported consoles.

2 files changed, 390 insertions, 2 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index be11096a43..7c7729859b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8391,7 +8391,7 @@ other things.
 
 @deftp {Data Type} mingetty-configuration
 This is the data type representing the configuration of Mingetty, which
-implements console log-in.
+provides the default implementation of virtual console log-in.
 
 @table @asis
 
@@ -8418,6 +8418,172 @@ The Mingetty package to use.
 @end table
 @end deftp
 
+@deffn {Scheme Procedure} agetty-service @var{config}
+Return a service to run agetty according to @var{config}, an
+@code{<agetty-configuration>} object, which specifies the tty to run,
+among other things.
+@end deffn
+
+@deftp {Data Type} agetty-configuration
+This is the data type representing the configuration of agetty, which
+implements virtual and serial console log-in.  See the @code{agetty(8)}
+man page for more information.
+
+@table @asis
+
+@item @code{tty}
+The name of the console this agetty runs on, as a string---e.g.,
+@code{"ttyS0"}. This argument is mandatory.
+
+@item @code{baud-rate} (default: @code{#f})
+A string containing a comma-separated list of one or more baud rates, in
+descending order.
+
+@item @code{term} (default: @code{#f})
+A string containing the value used for the @code{TERM} environment
+variable.
+
+@item @code{eight-bits?} (default: @code{#f})
+When @code{#t}, the tty is assumed to be 8-bit clean, and parity detection is
+disabled.
+
+@item @code{auto-login} (default: @code{#f})
+When passed a login name, as a string, the specified user will be logged
+in automatically without prompting for their login name or password.
+
+@item @code{no-reset?} (default: @code{#f})
+When @code{#t}, don't reset terminal cflags (control modes).
+
+@item @code{host} (default: @code{#f})
+This accepts a string containing the "login_host", which will be written
+into the @file{/var/run/utmpx} file.
+
+@item @code{remote?} (default: @code{#f})
+When set to @code{#t} in conjunction with @var{host}, this will add an
+@code{-r} fakehost option to the command line of the login program
+specified in @var{login-program}.
+
+@item @code{flow-control?} (default: @code{#f})
+When set to @code{#t}, enable hardware (RTS/CTS) flow control.
+
+@item @code{no-issue?} (default: @code{#f})
+When set to @code{#t}, the contents of the @file{/etc/issue} file will
+not be displayed before presenting the login prompt.
+
+@item @code{init-string} (default: @code{#f})
+This accepts a string that will be sent to the tty or modem before
+sending anything else.  It can be used to initialize a modem.
+
+@item @code{no-clear?} (default: @code{#f})
+When set to @code{#t}, agetty will not clear the screen before showing
+the login prompt.
+
+@item @code{login-program} (default: (file-append shadow "/bin/login"))
+This must be either a gexp denoting the name of a log-in program, or
+unset, in which case the default value is the @command{login} from the
+Shadow tool suite.
+
+@item @code{local-line} (default: @code{#f})
+Control the CLOCAL line flag.  This accepts one of three symbols as
+arguments, @code{'auto}, @code{'always}, or @code{'never}. If @code{#f},
+the default value chosen by agetty is @code{'auto}.
+
+@item @code{extract-baud?} (default: @code{#f})
+When set to @code{#t}, instruct agetty to try to extract the baud rate
+from the status messages produced by certain types of modems.
+
+@item @code{skip-login?} (default: @code{#f})
+When set to @code{#t}, do not prompt the user for a login name.  This
+can be used with @var{login-program} field to use non-standard login
+systems.
+
+@item @code{no-newline?} (default: @code{#f})
+When set to @code{#t}, do not print a newline before printing the
+@file{/etc/issue} file.
+
+@c Is this dangerous only when used with login-program, or always?
+@item @code{login-options} (default: @code{#f})
+This option accepts a string containing options that are passed to the
+login program.  When used with the @var{login-program}, be aware that a
+malicious user could try to enter a login name containing embedded
+options that could be parsed by the login program.
+
+@item @code{login-pause} (default: @code{#f})
+When set to @code{#t}, wait for any key before showing the login prompt.
+This can be used in conjunction with @var{auto-login} to save memory by
+lazily spawning shells.
+
+@item @code{chroot} (default: @code{#f})
+Change root to the specified directory.  This option accepts a directory
+path as a string.
+
+@item @code{hangup?} (default: @code{#f})
+Use the Linux system call @code{vhangup} to do a virtual hangup of the
+specified terminal.
+
+@item @code{keep-baud?} (default: @code{#f})
+When set to @code{#t}, try to keep the existing baud rate.  The baud
+rates from @var{baud-rate} are used when agetty receives a @key{BREAK}
+character.
+
+@item @code{timeout} (default: @code{#f})
+When set to an integer value, terminate if no user name could be read
+within @var{timeout} seconds.
+
+@item @code{detect-case?} (default: @code{#f})
+When set to @code{#t}, turn on support for detecting an uppercase-only
+terminal.  This setting will detect a login name containing only
+uppercase letters as indicating an uppercase-only terminal and turn on
+some upper-to-lower case conversions.  Note that this will not support
+Unicode characters.
+
+@item @code{wait-cr?} (default: @code{#f})
+When set to @code{#t}, wait for the user or modem to send a
+carriage-return or linefeed character before displaying
+@file{/etc/issue} or login prompt.  This is typically used with the
+@var{init-string} option.
+
+@item @code{no-hints?} (default: @code{#f})
+When set to @code{#t}, do not print hints about Num, Caps, and Scroll
+locks.
+
+@item @code{no-hostname?} (default: @code{#f})
+By default, the hostname is printed.  When this option is set to
+@code{#t}, no hostname will be shown at all.
+
+@item @code{long-hostname?} (default: @code{#f})
+By default, the hostname is only printed until the first dot.  When this
+option is set to @code{#t}, the fully qualified hostname by
+@code{gethostname} or @code{getaddrinfo} is shown.
+
+@item @code{erase-characters} (default: @code{#f})
+This option accepts a string of additional characters that should be
+interpreted as backspace when the user types their login name.
+
+@item @code{kill-characters} (default: @code{#f})
+This option accepts a string that should be interpreted to mean "ignore
+all previous characters" (also called a "kill" character) when the types
+their login name.
+
+@item @code{chdir} (default: @code{#f})
+This option accepts, as a string, a directory path that will be changed
+to before login.
+
+@item @code{delay} (default: @code{#f})
+This options accepts, as an integer, the number of seconds to sleep
+before opening the tty and displaying the login prompt.
+
+@item @code{nice} (default: @code{#f})
+This option accepts, as an integer, the nice value with which to run the
+@command{login} program.
+
+@item @code{extra-options} (default: @code{'()})
+This option provides an "escape hatch" for the user to provide arbitrary
+command-line arguments to @command{agetty} as a list of strings.
+
+@end table
+@end deftp
+
 @deffn {Scheme Procedure} kmscon-service-type @var{config}
 Return a service to run @uref{https://www.freedesktop.org/wiki/Software/kmscon,kmscon}
 according to @var{config}, a @code{<kmscon-configuration>} object, which
@@ -8426,7 +8592,7 @@ specifies the tty to run, among other things.
 
 @deftp {Data Type} kmscon-configuration
 This is the data type representing the configuration of Kmscon, which
-implements console log-in.
+implements virtual console log-in.
 
 @table @asis
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 7ae815d4b5..5298a11f63 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -38,6 +38,7 @@
                 #:select (canonical-package glibc))
   #:use-module (gnu packages bash)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
@@ -74,6 +75,11 @@
             login-service-type
             login-service
 
+            agetty-configuration
+            agetty-configuration?
+            agetty-service
+            agetty-service-type
+
             mingetty-configuration
             mingetty-configuration?
             mingetty-service
@@ -730,6 +736,222 @@ Return a service that sets up Unicode support in @var{tty} and loads
 the message of the day, among other things."
   (service login-service-type config))
 
+(define-record-type* <agetty-configuration>
+  agetty-configuration make-agetty-configuration
+  agetty-configuration?
+  (agetty           agetty-configuration-agetty   ;<package>
+                    (default util-linux))
+  (tty              agetty-configuration-tty)     ;string
+  (term             agetty-term                   ;string | #f
+                    (default #f))
+  (baud-rate        agetty-baud-rate              ;string | #f
+                    (default #f))
+  (auto-login       agetty-auto-login             ;list of strings | #f
+                    (default #f))
+  (login-program    agetty-login-program          ;gexp
+                    (default (file-append shadow "/bin/login")))
+  (login-pause?     agetty-login-pause?           ;Boolean
+                    (default #f))
+  (eight-bits?      agetty-eight-bits?            ;Boolean
+                    (default #f))
+  (no-reset?        agetty-no-reset?              ;Boolean
+                    (default #f))
+  (remote?          agetty-remote?                ;Boolean
+                    (default #f))
+  (flow-control?    agetty-flow-control?          ;Boolean
+                    (default #f))
+  (host             agetty-host                   ;string | #f
+                    (default #f))
+  (no-issue?        agetty-no-issue?              ;Boolean
+                    (default #f))
+  (init-string      agetty-init-string            ;string | #f
+                    (default #f))
+  (no-clear?        agetty-no-clear?              ;Boolean
+                    (default #f))
+  (local-line       agetty-local-line             ;always | never | auto
+                    (default #f))
+  (extract-baud?    agetty-extract-baud?          ;Boolean
+                    (default #f))
+  (skip-login?      agetty-skip-login?            ;Boolean
+                    (default #f))
+  (no-newline?      agetty-no-newline?            ;Boolean
+                    (default #f))
+  (login-options    agetty-login-options          ;string | #f
+                    (default #f))
+  (chroot           agetty-chroot                 ;string | #f
+                    (default #f))
+  (hangup?          agetty-hangup?                ;Boolean
+                    (default #f))
+  (keep-baud?       agetty-keep-baud?             ;Boolean
+                    (default #f))
+  (timeout          agetty-timeout                ;integer | #f
+                    (default #f))
+  (detect-case?     agetty-detect-case?           ;Boolean
+                    (default #f))
+  (wait-cr?         agetty-wait-cr?               ;Boolean
+                    (default #f))
+  (no-hints?        agetty-no-hints?              ;Boolean
+                    (default #f))
+  (no-hostname?     agetty-no hostname?           ;Boolean
+                    (default #f))
+  (long-hostname?   agetty-long-hostname?         ;Boolean
+                    (default #f))
+  (erase-characters agetty-erase-characters       ;string | #f
+                    (default #f))
+  (kill-characters  agetty-kill-characters        ;string | #f
+                    (default #f))
+  (chdir            agetty-chdir                  ;string | #f
+                    (default #f))
+  (delay            agetty-delay                  ;integer | #f
+                    (default #f))
+  (nice             agetty-nice                   ;integer | #f
+                    (default #f))
+  ;; "Escape hatch" for passing arbitrary command-line arguments.
+  (extra-options    agetty-extra-options          ;list of strings
+                    (default '()))
+;;; XXX Unimplemented for now!
+;;; (issue-file     agetty-issue-file             ;file-like
+;;;                 (default #f))
+  )
+
+(define agetty-shepherd-service
+  (match-lambda
+    (($ <agetty-configuration> agetty tty term baud-rate auto-login
+        login-program login-pause? eight-bits? no-reset? remote? flow-control?
+        host no-issue? init-string no-clear? local-line extract-baud?
+        skip-login? no-newline? login-options chroot hangup? keep-baud? timeout
+        detect-case? wait-cr? no-hints? no-hostname? long-hostname?
+        erase-characters kill-characters chdir delay nice extra-options)
+     (list
+       (shepherd-service
+         (documentation "Run agetty on a tty.")
+         (provision (list (symbol-append 'term- (string->symbol tty))))
+
+         ;; 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
+         ;; text is not lost in the middle of kernel messages (see also
+         ;; mingetty-shepherd-service).
+         (requirement '(user-processes host-name udev))
+
+         (start #~(make-forkexec-constructor
+                    (list #$(file-append util-linux "/sbin/agetty")
+                          #$@extra-options
+                          #$@(if eight-bits?
+                                 #~("--8bits")
+                                 #~())
+                          #$@(if no-reset?
+                                 #~("--noreset")
+                                 #~())
+                          #$@(if remote?
+                                 #~("--remote")
+                                 #~())
+                          #$@(if flow-control?
+                                 #~("--flow-control")
+                                 #~())
+                          #$@(if host
+                                 #~("--host" #$host)
+                                 #~())
+                          #$@(if no-issue?
+                                 #~("--noissue")
+                                 #~())
+                          #$@(if init-string
+                                 #~("--init-string" #$init-string)
+                                 #~())
+                          #$@(if no-clear?
+                                 #~("--noclear")
+                                 #~())
+;;; FIXME This doesn't work as expected. According to agetty(8), if this option
+;;; is not passed, then the default is 'auto'. However, in my tests, when that
+;;; option is selected, agetty never presents the login prompt, and the
+;;; term-ttyS0 service respawns every few seconds.
+                          #$@(if local-line
+                                 #~(#$(match local-line
+                                        ('auto "--local-line=auto")
+                                        ('always "--local-line=always")
+                                        ('never "-local-line=never")))
+                                 #~())
+                          #$@(if extract-baud?
+                                 #~("--extract-baud")
+                                 #~())
+                          #$@(if skip-login?
+                                 #~("--skip-login")
+                                 #~())
+                          #$@(if no-newline?
+                                 #~("--nonewline")
+                                 #~())
+                          #$@(if login-options
+                                 #~("--login-options" #$login-options)
+                                 #~())
+                          #$@(if chroot
+                                 #~("--chroot" #$chroot)
+                                 #~())
+                          #$@(if hangup?
+                                 #~("--hangup")
+                                 #~())
+                          #$@(if keep-baud?
+                                 #~("--keep-baud")
+                                 #~())
+                          #$@(if timeout
+                                 #~("--timeout" #$(number->string timeout))
+                                 #~())
+                          #$@(if detect-case?
+                                 #~("--detect-case")
+                                 #~())
+                          #$@(if wait-cr?
+                                 #~("--wait-cr")
+                                 #~())
+                          #$@(if no-hints?
+                                 #~("--nohints?")
+                                 #~())
+                          #$@(if no-hostname?
+                                 #~("--nohostname")
+                                 #~())
+                          #$@(if long-hostname?
+                                 #~("--long-hostname")
+                                 #~())
+                          #$@(if erase-characters
+                                 #~("--erase-chars" #$erase-characters)
+                                 #~())
+                          #$@(if kill-characters
+                                 #~("--kill-chars" #$kill-characters)
+                                 #~())
+                          #$@(if chdir
+                                 #~("--chdir" #$chdir)
+                                 #~())
+                          #$@(if delay
+                                 #~("--delay" #$(number->string delay))
+                                 #~())
+                          #$@(if nice
+                                 #~("--nice" #$(number->string nice))
+                                 #~())
+                          #$@(if auto-login
+                                 (list "--autologin" auto-login)
+                                 '())
+                          #$@(if login-program
+                                 #~("--login-program" #$login-program)
+                                 #~())
+                          #$@(if login-pause?
+                                 #~("--login-pause")
+                                 #~())
+                          #$tty
+                          #$@(if baud-rate
+                                 #~(#$baud-rate)
+                                 #~())
+                          #$@(if term
+                                 #~(#$term)
+                                 #~()))))
+         (stop #~(make-kill-destructor)))))))
+
+(define agetty-service-type
+  (service-type (name 'agetty)
+                (extensions (list (service-extension shepherd-root-service-type
+                                                     agetty-shepherd-service)))))
+
+(define* (agetty-service config)
+  "Return a service to run agetty according to @var{config}, which specifies
+the tty to run, among other things."
+  (service agetty-service-type config))
+
 (define-record-type* <mingetty-configuration>
   mingetty-configuration make-mingetty-configuration
   mingetty-configuration?