services: Add kanata-service-type.

* gnu/services/desktop.scm: Import (gnu packages rust-apps).
(kanata-configuration): New record type.
(kanata-shepherd-services): New procedure.
(%kanata-group, %kanata-user, %kanata-accounts, %kanata-udev-rule)
(kanata-service-type): New variables.
* doc/guix.texi (Desktop Services): Document `kanata-service-type'.

Change-Id: I5e8041c6dba17ae0fad33b8ca74099c053c4a3ea
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Merges: #9093

1 files changed, 86 insertions, 0 deletions

diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index d4a8878bfd3..d0f56cc434c 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -81,6 +81,7 @@
   #:use-module (gnu packages nfs)
   #:use-module (gnu packages enlightenment)
   #:use-module (gnu packages haskell-apps)
+  #:use-module (gnu packages rust-apps)
   #:use-module (guix deprecation)
   #:use-module (guix i18n)
   #:use-module (guix records)
@@ -130,6 +131,12 @@
             kmonad-configuration?
             kmonad-service-type
 
+            kanata-service-type
+            kanata-configuration
+            kanata-configuration?
+            kanata-configuration-kanata
+            kanata-configuration-keymaps
+
             geoclue-application
             geoclue-configuration
             geoclue-configuration?
@@ -1110,6 +1117,85 @@ and extending the functionalities of different keyboards.")))
 
 
 ;;;
+;;; Kanata.
+;;;
+
+(define-configuration/no-serialization kanata-configuration
+  (kanata
+   (package kanata)
+   "The @code{kanata} package to use.")
+  (keymaps
+   (list-of-file-likes '())
+   "List of @command{kanata} configuration files (file-like objects).  See
+@uref{https://jtroo.github.io/config.html#linux-only-linux-dev, Kanata's
+device specification documentation}."))
+
+(define %kanata-group
+  (user-group
+    (name "kanata")
+    (system? #t)))
+
+(define %kanata-user
+  (user-account
+    (name "kanata")
+    (group "kanata")
+    (supplementary-groups '("input" "uinput"))
+    (system? #t)
+    (comment "Kanata daemon user")
+    (home-directory "/var/empty")
+    (create-home-directory? #f)
+    (shell (file-append shadow "/sbin/nologin"))))
+
+(define %kanata-accounts
+  (list %uinput-group %kanata-group %kanata-user))
+
+;; OPTIONS+="static_node=uinput" triggers kmod to load the uinput module on
+;; boot.
+(define %kanata-udev-rule
+  (udev-rule
+   "99-kanata.rules"
+   "KERNEL==\"uinput\", MODE=\"0660\", GROUP=\"uinput\", OPTIONS+=\"static_node=uinput\"\n"))
+
+(define (kanata-shepherd-services config)
+  "Return a shepherd service for each @command{kanata} configuration."
+  (let* ((kanata  (file-append (kanata-configuration-kanata config)
+                               "/bin/kanata"))
+         (keymaps (kanata-configuration-keymaps config)))
+    (map (lambda (index keymap)
+           (let ((name (string-append "kanata-" (number->string index))))
+             (shepherd-service
+               (provision     (list (string->symbol name)))
+               (requirement   '(user-processes udev))
+               (documentation (string-append "Run kanata process "
+                                             (number->string index) "."))
+               (start         #~(make-forkexec-constructor
+                                 ;; '--no-wait' prevents pausing on exit so
+                                 ;; Shepherd can reliably restart the daemon.
+                                 (list #$kanata "-c" #$keymap "--no-wait")
+                                 #:user "kanata"
+                                 #:group "kanata"
+                                 #:supplementary-groups '("input" "uinput")
+                                 #:log-file #$(string-append "/var/log/" name ".log")))
+               (stop          #~(make-kill-destructor)))))
+         (iota (length keymaps))
+         keymaps)))
+
+(define kanata-service-type
+  (service-type
+    (name 'kanata)
+    (extensions
+     (list (service-extension account-service-type
+                              (const %kanata-accounts))
+           (service-extension shepherd-root-service-type
+                              kanata-shepherd-services)
+           (service-extension udev-service-type
+                              (const (list %kanata-udev-rule)))))
+    (description
+     "Run the @command{kanata} daemon, which allows customizing and extending
+the functionalities of different keyboards.")))
+
+
+;;;
 ;;; UDisks.
 ;;;