services: Add login-service.

* gnu/services/base.scm (%default-motd, <login-configuration>,
  login-pam-service, login-serivce-type, login-service): New variables.
  (<mingetty-configuration>, mingetty-shepherd-service,
  mingetty-serivce-type): Remove motd. Remove allow-empty-passwords?.
  Remove mingetty-pam-service.
  (%base-services): Add login-service. Remove motd.

2 files changed, 96 insertions, 62 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 7ed8ee8130..41b8d5db0b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6753,8 +6753,7 @@ following in your operating system declaration:
                         (extra-options '("--gc-keep-derivations"))))
     (mingetty-service-type config =>
                            (mingetty-configuration
-                            (inherit config)
-                            (motd (plain-file "motd" "Howdy!"))))))
+                            (inherit config)))))
 
 (operating-system
   ;; @dots{}
@@ -7619,6 +7618,27 @@ this:
 Return a service that sets the host name to @var{name}.
 @end deffn
 
+@deffn {Scheme Procedure} login-service @var{config}
+Return a service to run login according to @var{config}, a
+@code{<login-configuration>} object, which specifies the message of the day,
+among other things.
+@end deffn
+
+@deftp {Data Type} login-configuration
+This is the data type representing the configuration of login.
+
+@table @asis
+
+@item @code{motd}
+A file-like object containing the ``message of the day''.
+
+@item @code{allow-empty-passwords?} (default: @code{#t})
+Allow empty passwords by default so that first-time users can log in when
+the 'root' account has just been created.
+
+@end table
+@end deftp
+
 @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
@@ -7634,9 +7654,6 @@ implements console log-in.
 @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 system automatically logs in.  When it is @code{#f}, a
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 07c08d7567..20a9c3ae11 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -66,6 +66,11 @@
             udev-service
             udev-rule
 
+            login-configuration
+            login-configuration?
+            login-service-type
+            login-service
+
             mingetty-configuration
             mingetty-configuration?
             mingetty-service
@@ -656,41 +661,55 @@ strings or string-valued gexps."
   ;; codepoints notably found in the UTF-8 manual.
   (service console-font-service-type (list tty font)))
 
+(define %default-motd
+  (plain-file "motd" "This is the GNU operating system, welcome!\n\n"))
+
+(define-record-type* <login-configuration>
+  login-configuration make-login-configuration
+  login-configuration?
+  (motd                   login-configuration-motd     ;file-like
+                          (default %default-motd))
+  ;; Allow empty passwords by default so that first-time users can log in when
+  ;; the 'root' account has just been created.
+  (allow-empty-passwords? login-configuration-allow-empty-passwords?
+                          (default #t)))               ;Boolean
+
+(define (login-pam-service config)
+  "Return the list of PAM service needed for CONF."
+  ;; Let 'login' be known to PAM.
+  (list (unix-pam-service "login"
+                          #:allow-empty-passwords?
+                          (login-configuration-allow-empty-passwords? config)
+                          #:motd
+                          (login-configuration-motd config))))
+
+(define login-service-type
+  (service-type (name 'login)
+                (extensions (list (service-extension pam-root-service-type
+                                                     login-pam-service)))))
+
+(define* (login-service #:optional (config (login-configuration)))
+  "Return a service configure login according to @var{config}, which specifies
+the message of the day, among other things."
+  (service login-service-type config))
+
 (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-pam-service conf)
-  "Return the list of PAM service needed for CONF."
-  ;; 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?
-                          (mingetty-configuration-allow-empty-passwords? conf)
-                          #:motd
-                          (mingetty-configuration-motd conf))))
+                  (default #f)))
 
 (define mingetty-shepherd-service
   (match-lambda
-    (($ <mingetty-configuration> mingetty tty motd auto-login login-program
-                                 login-pause? allow-empty-passwords?)
+    (($ <mingetty-configuration> mingetty tty auto-login login-program
+                                 login-pause?)
      (list
       (shepherd-service
        (documentation "Run mingetty on an tty.")
@@ -718,9 +737,7 @@ strings or string-valued gexps."
 (define mingetty-service-type
   (service-type (name 'mingetty)
                 (extensions (list (service-extension shepherd-root-service-type
-                                                     mingetty-shepherd-service)
-                                  (service-extension pam-root-service-type
-                                                     mingetty-pam-service)))))
+                                                     mingetty-shepherd-service)))))
 
 (define* (mingetty-service config)
   "Return a service to run mingetty according to @var{config}, which specifies
@@ -1435,38 +1452,38 @@ This service is not part of @var{%base-services}."
 
 (define %base-services
   ;; Convenience variable holding the basic services.
-  (let ((motd (plain-file "motd" "
-This is the GNU operating system, welcome!\n\n")))
-    (list (console-font-service "tty1")
-          (console-font-service "tty2")
-          (console-font-service "tty3")
-          (console-font-service "tty4")
-          (console-font-service "tty5")
-          (console-font-service "tty6")
-
-          (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)
-          (urandom-seed-service)
-          (guix-service)
-          (nscd-service)
-
-          ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is
-          ;; used, so enable them by default.  The FUSE and ALSA rules are
-          ;; less critical, but handy.
-          (udev-service #:rules (list lvm2 fuse alsa-utils crda)))))
+  (list (login-service)
+
+        (console-font-service "tty1")
+        (console-font-service "tty2")
+        (console-font-service "tty3")
+        (console-font-service "tty4")
+        (console-font-service "tty5")
+        (console-font-service "tty6")
+
+        (mingetty-service (mingetty-configuration
+                           (tty "tty1")))
+        (mingetty-service (mingetty-configuration
+                           (tty "tty2")))
+        (mingetty-service (mingetty-configuration
+                           (tty "tty3")))
+        (mingetty-service (mingetty-configuration
+                           (tty "tty4")))
+        (mingetty-service (mingetty-configuration
+                           (tty "tty5")))
+        (mingetty-service (mingetty-configuration
+                           (tty "tty6")))
+
+        (static-networking-service "lo" "127.0.0.1"
+                                   #:provision '(loopback))
+        (syslog-service)
+        (urandom-seed-service)
+        (guix-service)
+        (nscd-service)
+
+        ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is
+        ;; used, so enable them by default.  The FUSE and ALSA rules are
+        ;; less critical, but handy.
+        (udev-service #:rules (list lvm2 fuse alsa-utils crda))))
 
 ;;; base.scm ends here