06/12: PRELIM: services: mingetty-service: Use <mingetty-configuration> objects.

[Ludovic Courtès]

civodul pushed a commit to branch wip-service-refactor
in repository guix.

commit ad8747be9f74ff2717d3e37ccf252fa2ce52fd2e
Author: Ludovic Courtès <address@hidden>
Date:   Sat Sep 12 13:53:21 2015 +0200

    PRELIM: services: mingetty-service: Use <mingetty-configuration> objects.
    
    PRELIM: Documentation needs to be updated.
    
    * 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.
---
 gnu/services/base.scm  |  130 ++++++++++++++++++++++++++----------------------
 gnu/system/install.scm |   24 +++++----
 2 files changed, 83 insertions(+), 71 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 799526c..ac7a37f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -50,6 +50,9 @@
             console-keymap-service
             console-font-service
             udev-service
+
+            mingetty-configuration
+            mingetty-configuration?
             mingetty-service
 
             %nscd-default-caches
@@ -342,60 +345,60 @@ 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
address@hidden 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
address@hidden, 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.)
-
address@hidden 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?
+  (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}, which specifies
+the tty to run, among other things."
+  (match config
+    (($ <mingetty-configuration> 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 +844,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)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 1ba36c3..560d64b 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -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)