[PATCH] services: Add kmscon service.

[PATCH] services: Add kmscon service.

[David Craven]

* gnu/services/base.scm (<kmscon-configuration>,
  kmscon-shepherd-service, kmscon-service-type, kmscon-service): New
  variables.
---
 gnu/services/base.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 99a6759..efd72c7 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -39,6 +39,7 @@
   #:use-module (gnu packages package-management)
   #:use-module (gnu packages ssh)
   #:use-module (gnu packages lsof)
+  #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
                 #:select (mount-flags->bit-mask))
   #:use-module (guix gexp)
@@ -116,6 +117,12 @@
             rngd-configuration?
             rngd-service-type
             rngd-service
+
+            kmscon-configuration
+            kmscon-configuration?
+            kmscon-service-type
+            kmscon-service
+
             pam-limits-service-type
             pam-limits-service
 
@@ -1449,6 +1456,52 @@ This service is not part of @var{%base-services}."
   (service gpm-service-type
            (gpm-configuration (gpm gpm) (options options))))
 
+(define-record-type* <kmscon-configuration>
+  kmscon-configuration   make-kmscon-configuration
+  kmscon-configuration?
+  (kmscon                kmscon-configuration-kmscon
+                         (default kmscon))
+  (vt                    kmscon-configuration-vt)
+  (login-program         kmscon-configuration-login-program
+                         (default #~(string-append #$shadow "/bin/login")))
+  (login-arguments       kmscon-configuration-login-arguments
+                         (default '("-p")))
+  (hwaccel?              kmscon-configuration-hwaccel?
+                         (default #f))) ; #t causes failure
+
+(define (kmscon-shepherd-service config)
+  "Return a <shepherd-service> for kmscon with CONFIG."
+  (let ((kmscon (kmscon-configuration-kmscon config))
+        (vt (kmscon-configuration-vt config))
+        (login-program (kmscon-configuration-login-program config))
+        (login-arguments (kmscon-configuration-login-arguments config))
+        (hwaccel? (kmscon-configuration-hwaccel? config)))
+
+    (define kmscon-command
+      #~(list
+         (string-append #$kmscon "/bin/kmscon") "--login"
+         "--vt" #$vt
+         #$@(if hwaccel? '("--hwaccel") '())
+         "--" #$login-program #$@login-arguments))
+
+  (list (shepherd-service
+    (documentation "kmscon virtual terminal")
+    (requirement '(user-processes udev))
+    (provision (list (symbol-append 'term- (string->symbol vt))))
+    (start #~(make-forkexec-constructor #$kmscon-command))
+    (stop #~(make-kill-destructor))))))
+
+(define kmscon-service-type
+  (service-type (name 'kmscon)
+    (extensions
+      (list (service-extension shepherd-root-service-type
+                               kmscon-shepherd-service)))))
+
+(define* (kmscon-service config)
+  "Run the @command{kmscon} daemon from @var{kmscon} to start a virtual
+terminal."
+  (service kmscon-service-type config))
+
 \f
 (define %base-services
   ;; Convenience variable holding the basic services.
-- 
2.9.0

[PATCH] services: Add login-service.

[David Craven]

* 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.
---
 gnu/services/base.scm | 131 ++++++++++++++++++++++++++++----------------------
 1 file changed, 74 insertions(+), 57 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 2c2962c..99a6759 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}."
 \f
 (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
-- 
2.9.0

Re: [PATCH] services: Add kmscon service.

[Ludovic Courtès]

Hello!

David Craven <david@craven.ch> skribis:

> * gnu/services/base.scm (<kmscon-configuration>,
>   kmscon-shepherd-service, kmscon-service-type, kmscon-service): New
>   variables.

I didn’t know kmscon, that looks pretty interesting.

> +(define-record-type* <kmscon-configuration>
> +  kmscon-configuration   make-kmscon-configuration
> +  kmscon-configuration?
> +  (kmscon                kmscon-configuration-kmscon
> +                         (default kmscon))
> +  (vt                    kmscon-configuration-vt)

s/vt/virtual-terminal/

> +  (login-program         kmscon-configuration-login-program
> +                         (default #~(string-append #$shadow "/bin/login")))
> +  (login-arguments       kmscon-configuration-login-arguments
> +                         (default '("-p")))
> +  (hwaccel?              kmscon-configuration-hwaccel?

“hardware-acceleration?”

> +(define (kmscon-shepherd-service config)
> +  "Return a <shepherd-service> for kmscon with CONFIG."
> +  (let ((kmscon (kmscon-configuration-kmscon config))
> +        (vt (kmscon-configuration-vt config))
> +        (login-program (kmscon-configuration-login-program config))
> +        (login-arguments (kmscon-configuration-login-arguments config))
> +        (hwaccel? (kmscon-configuration-hwaccel? config)))
> +
> +    (define kmscon-command
> +      #~(list
> +         (string-append #$kmscon "/bin/kmscon") "--login"
> +         "--vt" #$vt
> +         #$@(if hwaccel? '("--hwaccel") '())
> +         "--" #$login-program #$@login-arguments))
> +
> +  (list (shepherd-service
> +    (documentation "kmscon virtual terminal")
> +    (requirement '(user-processes udev))
> +    (provision (list (symbol-append 'term- (string->symbol vt))))
> +    (start #~(make-forkexec-constructor #$kmscon-command))
> +    (stop #~(make-kill-destructor))))))
> +
> +(define kmscon-service-type
> +  (service-type (name 'kmscon)
> +    (extensions
> +      (list (service-extension shepherd-root-service-type
> +                               kmscon-shepherd-service)))))

This can be shortened using ‘shepherd-service-type’.

> +(define* (kmscon-service config)
> +  "Run the @command{kmscon} daemon from @var{kmscon} to start a virtual
> +terminal."
> +  (service kmscon-service-type config))

I would not bother with this procedure and instead expose
‘kmscon-service-type’ and ‘kmscon-configuration’.

Could you augment guix.texi for these two things, with a bit of context
and an @uref to <https://www.freedesktop.org/wiki/Software/kmscon/>?

Thank you!

Ludo’.

Re: [PATCH] services: Add login-service.

[Ludovic Courtès]

David Craven <david@craven.ch> skribis:

> * 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.

Could you update guix.texi with (1) @deftp login-configuration, and (2)
removing fields from @deftp mingetty-configuration?

Otherwise LGTM.

Thank you!

Ludo’.

Re: [PATCH] services: Add kmscon service.

[Ludovic Courtès]

David Craven <david@craven.ch> skribis:

> +  (list (shepherd-service
> +    (documentation "kmscon virtual terminal")
> +    (requirement '(user-processes udev))

Looking at the doc, I’m under the impression that this should also
depend on elogind no?  (I think it needs to talk to elogind to tell it
about “seats” being used etc.)

Ludo’.

Re: [PATCH] services: Add kmscon service.

[Ludovic Courtès]

I noticed that despite the dependency of kmscon on elogind, elogind
support was missing.  I added it in commit
5acf00f99072cd4da8d3ba064f19cc819288d68b.

Ludo’.

Re: [PATCH] services: Add kmscon service.

[David Craven]

Nice! Thanks!

Re: [PATCH] services: Add kmscon service.

[David Craven]

> Looking at the doc, I’m under the impression that this should also
> depend on elogind no?  (I think it needs to talk to elogind to tell it
> about “seats” being used etc.)

logind is an optional dependency. How do I make a shepherd service
depend on a dbus-service?

Re: [PATCH] services: Add kmscon service.

[Ludovic Courtès]

David Craven <david@craven.ch> skribis:

>> Looking at the doc, I’m under the impression that this should also
>> depend on elogind no?  (I think it needs to talk to elogind to tell it
>> about “seats” being used etc.)
>
> logind is an optional dependency. How do I make a shepherd service
> depend on a dbus-service?

Like this:

  (shepherd-service
    (requirements '(dbus-system))
    …)

Search for ‘shepherd-service’ in (gnu services desktop), or run ‘guix
system shepherd-graph’ to see the Shepherd service names.

In fact elogind is automatically started by dbus-daemon on demand, so
there’s no dependency to be expressed here, other than that on
‘dbus-system’.

Thanks,
Ludo’.