~ruther/guix-local

66e4f01c601bfad813011a811796e70f970258f9 — Ludovic Courtès 10 years ago be1c2c5
services: mingetty-service: Use <mingetty-configuration> objects.

* gnu/services/base.scm (<mingetty-configuration>): New record type.
  (mingetty-service): Expect a single <mingetty-configuration> instead
  of keyword arguments.
  (%base-services): Adjust accordingly.
* gnu/system/install.scm (installation-services): Likewise.
* doc/guix.texi (Base Services): Adjust accordingly.
3 files changed, 122 insertions(+), 88 deletions(-)

M doc/guix.texi
M gnu/services/base.scm
M gnu/system/install.scm
M doc/guix.texi => doc/guix.texi +36 -17
@@ 5753,25 5753,44 @@ this:
Return a service that sets the host name to @var{name}.
@end deffn

@deffn {Scheme Procedure} mingetty-service @var{tty} [#:motd] @
       [#:auto-login #f] [#:login-program] [#:login-pause? #f] @
       [#:allow-empty-passwords? #f]
Return a service to run mingetty on @var{tty}.

When @var{allow-empty-passwords?} is true, allow empty log-in password.  When
@var{auto-login} is true, it must be a user name under which to log-in
automatically.  @var{login-pause?} can be set to @code{#t} in conjunction with
@var{auto-login}, in which case the user will have to press a key before the
login shell is launched.

When true, @var{login-program} is a gexp denoting the name
of the log-in program (the default is the @code{login} program from the Shadow
tool suite.)

@var{motd} is a monadic value containing a text file to use as
the ``message of the day''.
@deffn {Scheme Procedure} mingetty-service @var{config}
Return a service to run mingetty according to @var{config}, a
@code{<mingetty-configuration>} object, which specifies the tty to run, among
other things.
@end deffn

@deftp {Data Type} mingetty-configuration
This is the data type representing the configuration of Mingetty, which
implements console log-in.

@table @asis

@item @code{tty}
The name of the console this Mingetty runs on---e.g., @code{"tty1"}.

@item @code{motd}
A file-like object containing the ``message of the day''.

@item @code{auto-login} (default: @code{#f})
When true, this field must be a string denoting the user name under
which the the system automatically logs in.  When it is @code{#f}, a
user name and password must be entered to log in.

@item @code{login-program} (default: @code{#f})
This must be either @code{#f}, in which case the default log-in program
is used (@command{login} from the Shadow tool suite), or a gexp denoting
the name of the log-in program.

@item @code{login-pause?} (default: @code{#f})
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{mingetty} (default: @var{mingetty})
The Mingetty package to use.

@end table
@end deftp

@cindex name service cache daemon
@cindex nscd
@deffn {Scheme Procedure} nscd-service [@var{config}] [#:glibc glibc] @

M gnu/services/base.scm => gnu/services/base.scm +73 -60
@@ 50,6 50,9 @@
            console-keymap-service
            console-font-service
            udev-service

            mingetty-configuration
            mingetty-configuration?
            mingetty-service

            %nscd-default-caches


@@ 342,60 345,63 @@ stopped before 'kill' is called."
     (stop #~(const #t))
     (respawn? #f))))

(define* (mingetty-service tty
                           #:key
                           (motd (plain-file "motd" "Welcome.\n"))
                           auto-login
                           login-program
                           login-pause?

                           ;; Allow empty passwords by default so that
                           ;; first-time users can log in when the 'root'
                           ;; account has just been created.
                           (allow-empty-passwords? #t))
  "Return a service to run mingetty on @var{tty}.

When @var{allow-empty-passwords?} is true, allow empty log-in password.  When
@var{auto-login} is true, it must be a user name under which to log-in
automatically.  @var{login-pause?} can be set to @code{#t} in conjunction with
@var{auto-login}, in which case the user will have to press a key before the
login shell is launched.

When true, @var{login-program} is a gexp denoting the name
of the log-in program (the default is the @code{login} program from the Shadow
tool suite.)

@var{motd} is a file-like object to use as the ``message of the day''."
  (service
   (documentation (string-append "Run mingetty on " 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 (XXX).
   (requirement '(user-processes host-name udev))

   (start  #~(make-forkexec-constructor
              (list (string-append #$mingetty "/sbin/mingetty")
                    "--noclear" #$tty
                    #$@(if auto-login
                           #~("--autologin" #$auto-login)
                           #~())
                    #$@(if login-program
                           #~("--loginprog" #$login-program)
                           #~())
                    #$@(if login-pause?
                           #~("--loginpause")
                           #~()))))
   (stop   #~(make-kill-destructor))

   (pam-services
    ;; Let 'login' be known to PAM.  All the mingetty services will have
    ;; that PAM service, but that's fine because they're all identical and
    ;; duplicates are removed.
    (list (unix-pam-service "login"
                            #:allow-empty-passwords? allow-empty-passwords?
                            #:motd motd)))))
(define-record-type* <mingetty-configuration>
  mingetty-configuration make-mingetty-configuration
  mingetty-configuration?
  (mingetty       mingetty-configuration-mingetty ;<package>
                  (default mingetty))
  (tty            mingetty-configuration-tty)     ;string
  (motd           mingetty-configuration-motd     ;file-like
                  (default (plain-file "motd" "Welcome.\n")))
  (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))

  ;; Allow empty passwords by default so that first-time users can log in when
  ;; the 'root' account has just been created.
  (allow-empty-passwords? mingetty-configuration-allow-empty-passwords?
                          (default #t)))          ;Boolean

(define* (mingetty-service config)
  "Return a service to run mingetty according to @var{config}, a
@code{<mingetty-configuration>} object, which specifies the tty to run, among
other things."
  (match config
    (($ <mingetty-configuration> mingetty tty motd auto-login login-program
                                 login-pause? allow-empty-passwords?)
     (service
      (documentation "Run mingetty on an 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 (XXX).
      (requirement '(user-processes host-name udev))

      (start  #~(make-forkexec-constructor
                 (list (string-append #$mingetty "/sbin/mingetty")
                       "--noclear" #$tty
                       #$@(if auto-login
                              #~("--autologin" #$auto-login)
                              #~())
                       #$@(if login-program
                              #~("--loginprog" #$login-program)
                              #~())
                       #$@(if login-pause?
                              #~("--loginpause")
                              #~()))))
      (stop   #~(make-kill-destructor))

      (pam-services
       ;; Let 'login' be known to PAM.  All the mingetty services will have
       ;; that PAM service, but that's fine because they're all identical and
       ;; duplicates are removed.
       (list (unix-pam-service "login"
                               #:allow-empty-passwords? allow-empty-passwords?
                               #:motd motd)))))))

(define-record-type* <nscd-configuration> nscd-configuration
  make-nscd-configuration


@@ 841,12 847,19 @@ This is the GNU operating system, welcome!\n\n")))
          (console-font-service "tty5")
          (console-font-service "tty6")

          (mingetty-service "tty1" #:motd motd)
          (mingetty-service "tty2" #:motd motd)
          (mingetty-service "tty3" #:motd motd)
          (mingetty-service "tty4" #:motd motd)
          (mingetty-service "tty5" #:motd motd)
          (mingetty-service "tty6" #:motd motd)
          (mingetty-service (mingetty-configuration
                             (tty "tty1") (motd motd)))
          (mingetty-service (mingetty-configuration
                             (tty "tty2") (motd motd)))
          (mingetty-service (mingetty-configuration
                             (tty "tty3") (motd motd)))
          (mingetty-service (mingetty-configuration
                             (tty "tty4") (motd motd)))
          (mingetty-service (mingetty-configuration
                             (tty "tty5") (motd motd)))
          (mingetty-service (mingetty-configuration
                             (tty "tty6") (motd motd)))

          (static-networking-service "lo" "127.0.0.1"
                                     #:provision '(loopback))
          (syslog-service)

M gnu/system/install.scm => gnu/system/install.scm +13 -11
@@ 242,22 242,24 @@ it is alpha software, so it may BREAK IN UNEXPECTED WAYS.
You have been warned.  Thanks for being so brave.
")))
    (define (normal-tty tty)
      (mingetty-service tty
                        #:motd motd
                        #:auto-login "root"
                        #:login-pause? #t))
      (mingetty-service (mingetty-configuration (tty tty)
                                                (motd motd)
                                                (auto-login "root")
                                                (login-pause? #t))))

    (list (mingetty-service "tty1"
                            #:motd motd
                            #:auto-login "root")
    (list (mingetty-service (mingetty-configuration
                             (tty "tty1")
                             (motd motd)
                             (auto-login "root")))

          ;; Documentation.  The manual is in UTF-8, but
          ;; 'console-font-service' sets up Unicode support and loads a font
          ;; with all the useful glyphs like em dash and quotation marks.
          (mingetty-service "tty2"
                            #:motd motd
                            #:auto-login "guest"
                            #:login-program (log-to-info))
          (mingetty-service (mingetty-configuration
                             (tty "tty2")
                             (motd motd)
                             (auto-login "guest")
                             (login-program (log-to-info))))

          ;; Documentation add-on.
          (configuration-template-service)