~ruther/guix-local

9ee4c9ab6f1aa6592a234918dc3946e79317c6dd — Leo Famulari 9 years ago a78e0bd
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(-)

M doc/guix.texi
M gnu/services/base.scm
M doc/guix.texi => doc/guix.texi +168 -2
@@ 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


M gnu/services/base.scm => gnu/services/base.scm +222 -0
@@ 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?