~ruther/guix-local

7068f6f7a5a53a29e9650b097924246cf0d445b4 — Tomas Volf 1 year, 10 months ago b8d72ef
services: mingetty: Add additional configuration options.

Not all aspects of mingetty were configurable, so this commit adds the
additional configuration fields to support that.

* gnu/services/base.scm (<mingetty-configuration>): Add delay, print-issue,
print-hostname, nice, working-directory, root-directory fields.
(mingetty-shepherd-service): Use the new fields.
(define-module)<#:export>: Export the new accessors.
* doc/guix.texi (Base Services)<mingetty-configuration>: Document the
additional field.

Change-Id: I4557a82498805ade0b341feda9d33eccc305690f
2 files changed, 86 insertions(+), 14 deletions(-)

M doc/guix.texi
M gnu/services/base.scm
M doc/guix.texi => doc/guix.texi +27 -1
@@ 19429,7 19429,33 @@ When set to @code{#t} in conjunction with @var{auto-login}, the user
will have to press a key before the log-in shell is launched.

@item @code{clear-on-logout?} (default: @code{#t})
When set to @code{#t}, the screen will be cleared after logout.
When set to @code{#t}, the screen will be cleared before showing the
login prompt.  The field name is bit unfortunate, since it controls
clearing also before the initial login, not just after a logout.

@item @code{delay} (default: @code{#f})
When set to a number, sleep that many seconds after startup.

@item @code{print-issue} (default: @code{#t})
When set to @code{#t}, write out a new line and the content of
@file{/etc/issue}.  Value of @code{'no-nl} can be used to suppress the
new line.

@item @code{print-hostname} (default: @code{#t})
When set to @code{#t}, print the host name before the login prompt.  The
host name is printed up to the first dot.  Can be set to @code{'long} to
print the full host name.

@item @code{nice} (default: @code{#f})
When set to a number, change the process priority using @code{nice}.

@item @code{working-directory} (default: @code{#f})
When set to a string, change into that directory before calling the
login program.

@item @code{root-directory} (default: @code{#f})
When set to a string, use this directory at the process's root
directory.

@item @code{mingetty} (default: @var{mingetty})
The Mingetty package to use.

M gnu/services/base.scm => gnu/services/base.scm +59 -13
@@ 187,6 187,12 @@
            mingetty-configuration-login-pause?
            mingetty-configuration-clear-on-logout?
            mingetty-configuration-mingetty
            mingetty-configuration-delay
            mingetty-configuration-print-issue
            mingetty-configuration-print-hostname
            mingetty-configuration-nice
            mingetty-configuration-working-directory
            mingetty-configuration-root-directory
            mingetty-configuration?
            mingetty-service  ; deprecated
            mingetty-service-type


@@ 1240,22 1246,36 @@ the tty to run, among other things."
(define-record-type* <mingetty-configuration>
  mingetty-configuration make-mingetty-configuration
  mingetty-configuration?
  (mingetty         mingetty-configuration-mingetty ;file-like
                    (default mingetty))
  (tty              mingetty-configuration-tty)     ;string
  (auto-login       mingetty-auto-login             ;string | #f
                    (default #f))
  (login-program    mingetty-login-program          ;gexp
                    (default #f))
  (login-pause?     mingetty-login-pause?           ;Boolean
                    (default #f))
  (clear-on-logout? mingetty-clear-on-logout?       ;Boolean
                    (default #t)))
  (mingetty          mingetty-configuration-mingetty ;file-like
                     (default mingetty))
  (tty               mingetty-configuration-tty) ;string
  (auto-login        mingetty-auto-login         ;string | #f
                     (default #f))
  (login-program     mingetty-login-program ;gexp
                     (default #f))
  (login-pause?      mingetty-login-pause? ;Boolean
                     (default #f))
  (clear-on-logout?  mingetty-clear-on-logout? ;Boolean
                     (default #t))
  (delay             mingetty-configuration-delay ;Integer | #f
                     (default #f))
  (print-issue       mingetty-configuration-print-issue ;Boolean | Symbol
                     (default #t))
  (print-hostname    mingetty-configuration-print-hostname ;Boolean | Symbol
                     (default #t))
  (nice              mingetty-configuration-nice ;Integer | #f
                     (default #f))
  (working-directory mingetty-configuration-working-directory ;String | #f
                     (default #f))
  (root-directory    mingetty-configuration-root-directory ;String | #f
                     (default #f)))

(define (mingetty-shepherd-service config)
  (match-record config <mingetty-configuration>
    (mingetty tty auto-login login-program
              login-pause? clear-on-logout?)
                ( mingetty tty auto-login login-program
                  login-pause? clear-on-logout? delay
                  print-issue print-hostname nice
                  working-directory root-directory)
    (list
     (shepherd-service
      (documentation "Run mingetty on an tty.")


@@ 1286,6 1306,32 @@ the tty to run, among other things."
                              #~())
                       #$@(if login-pause?
                              #~("--loginpause")
                              #~())
                       #$@(if delay
                              #~("--delay" #$(number->string delay))
                              #~())
                       #$@(match print-issue
                            (#t
                             #~())
                            ('no-nl
                             #~("--nonewline"))
                            (#f
                             #~("--noissue")))
                       #$@(match print-hostname
                            (#t
                             #~())
                            ('long
                             #~("--long-hostname"))
                            (#f
                             #~("--nohostname")))
                       #$@(if nice
                              #~("--nice" #$(number->string nice))
                              #~())
                       #$@(if working-directory
                              #~("--chdir" #$working-directory)
                              #~())
                       #$@(if root-directory
                              #~("--chroot" #$root-directory)
                              #~()))))
      (stop   #~(make-kill-destructor))))))