From 46ec2707a459f376dd72ea6e545662f51157c95e Mon Sep 17 00:00:00 2001
From: David Craven <david@craven.ch>
Date: Wed, 20 Jul 2016 13:17:07 +0200
Subject: [PATCH] services: Add kmscon service.

* gnu/services/base.scm (<kmscon-configuration>, kmscon-service-type):
  New variables.
* doc/guix.texi (@deffn kmscon-service-type, @deftp
  kmscon-configuration): Add documentation.
---
 doc/guix.texi         | 31 +++++++++++++++++++++++++++++++
 gnu/services/base.scm | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 74 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 41b8d5db0b..65cf804f1e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7674,6 +7674,37 @@ The Mingetty package to use.
 @end table
 @end deftp
 
+@deffn {Scheme Procedure} kmscon-service-type @var{config}
+Return a service to run @uref{https://www.freedesktop.org/wiki/Software/kmscon,kmscon}
+according to @var{config}, a @code{<kmscon-configuration>} object, which
+specifies the tty to run, among other things.
+@end deffn
+
+@deftp {Data Type} kmscon-configuration
+This is the data type representing the configuration of Kmscon, which
+implements console log-in.
+
+@table @asis
+
+@item @code{virtual-terminal}
+The name of the console this Kmscon runs on---e.g., @code{"tty1"}.
+
+@item @code{login-program} (default: @code{#~(string-append #$shadow "/bin/login")})
+A gexp denoting the name of the log-in program. The default log-in program is
+@command{login} from the Shadow tool suite.
+
+@item @code{login-arguments} (default: @code{'("-p")})
+A list of arguments to pass to @command{login}.
+
+@item @code{hardware-acceleration?} (default: #f)
+Whether to use hardware acceleration.
+
+@item @code{kmscon} (default: @var{kmscon})
+The Kmscon package to use.
+
+@end table
+@end deftp
+
 @cindex name service cache daemon
 @cindex nscd
 @deffn {Scheme Procedure} nscd-service [@var{config}] [#:glibc glibc] @
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 20a9c3ae11..4c1c481453 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,11 @@
             rngd-configuration?
             rngd-service-type
             rngd-service
+
+            kmscon-configuration
+            kmscon-configuration?
+            kmscon-service-type
+
             pam-limits-service-type
             pam-limits-service
 
@@ -1449,6 +1455,43 @@ 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))
+  (virtual-terminal        kmscon-configuration-virtual-terminal)
+  (login-program           kmscon-configuration-login-program
+                           (default #~(string-append #$shadow "/bin/login")))
+  (login-arguments         kmscon-configuration-login-arguments
+                           (default '("-p")))
+  (hardware-acceleration?  kmscon-configuration-hardware-acceleration?
+                           (default #f))) ; #t causes failure
+
+(define kmscon-service-type
+  (shepherd-service-type
+   'kmscon
+   (lambda (config)
+     (let ((kmscon (kmscon-configuration-kmscon config))
+           (virtual-terminal (kmscon-configuration-virtual-terminal config))
+           (login-program (kmscon-configuration-login-program config))
+           (login-arguments (kmscon-configuration-login-arguments config))
+           (hardware-acceleration? (kmscon-configuration-hardware-acceleration? config)))
+
+       (define kmscon-command
+         #~(list
+            (string-append #$kmscon "/bin/kmscon") "--login"
+            "--vt" #$virtual-terminal
+            #$@(if hardware-acceleration? '("--hwaccel") '())
+            "--" #$login-program #$@login-arguments))
+
+       (shepherd-service
+        (documentation "kmscon virtual terminal")
+        (requirement '(user-processes udev dbus-system))
+        (provision (list (symbol-append 'term- (string->symbol virtual-terminal))))
+        (start #~(make-forkexec-constructor #$kmscon-command))
+        (stop #~(make-kill-destructor)))))))
+
 
 (define %base-services
   ;; Convenience variable holding the basic services.