unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] services: Add kmscon service.
@ 2016-09-06 14:27 David Craven
  2016-09-06 14:27 ` [PATCH] services: Add login-service David Craven
                   ` (3 more replies)
  0 siblings, 4 replies; 9+ messages in thread
From: David Craven @ 2016-09-06 14:27 UTC (permalink / raw)
  To: guix-devel

* 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

^ permalink raw reply related	[flat|nested] 9+ messages in thread
end of thread, other threads:[~2016-09-11 13:57 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-09-06 14:27 [PATCH] services: Add kmscon service David Craven
2016-09-06 14:27 ` [PATCH] services: Add login-service David Craven
2016-09-08 21:40   ` Ludovic Courtès
2016-09-08 21:34 ` [PATCH] services: Add kmscon service Ludovic Courtès
2016-09-08 21:51 ` Ludovic Courtès
2016-09-08 22:19 ` Ludovic Courtès
2016-09-08 22:30   ` David Craven
2016-09-11 12:23     ` David Craven
2016-09-11 13:57       ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).