[bug#33714] [PATCH] services: Add quassel.

[Efraim Flashner <efraim@flashner.co.il>]

* gnu/services/messaging.scm (<quassel-configuration>): New record type.
(%quassel-account, %quassel-activation): New procedures.
(quassel-service-type): New variable.
* gnu/tests/messaging.scm (%test-quassel): New variable.
(run-quassel-test): New procedure.
* doc/guix.texi (Messaging): Document quassel service.
---
 doc/guix.texi              | 31 +++++++++++++
 gnu/services/messaging.scm | 90 +++++++++++++++++++++++++++++++++++++-
 gnu/tests/messaging.scm    | 54 ++++++++++++++++++++++-
 3 files changed, 173 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 20b5013fd..af78d9e46 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -16270,6 +16270,37 @@ Configuration snippet added as-is to the BitlBee configuration file.
 @end table
 @end deftp
 
+@subsubheading Quassel Service
+
+@cindex IRC (Internet Relay Chat)
+@url{https://quassel-irc.org/,Quassel} is a distributed IRC client,
+meaning that one or more clients can attach to and detach from the
+central core.
+
+@defvr {Scheme Variable} quassel-service-type
+This is the service type for the @url{https://quassel-irc.org/,Quassel}
+IRC backend daemon.  Its value is a @code{quassel-configuration}
+(see below).
+@end defvr
+
+@deftp {Data Type} quassel-configuration
+This is the configuration for Quassel, with the following fields:
+
+@table @asis
+@item @code{quassel} (default: @code{quassel})
+The Quassel package to use.
+
+@item @code{interface} (default: @code{"::,0.0.0.0"})
+@item @code{port} (default: @code{4242})
+Listen on the network interface(s) corresponding to the IPv4 or IPv6
+interfaces specified in the comma delimited @var{interface}, on
+@var{port}.
+
+@item @code{loglevel} (default: @code{"Info"})
+The level of logging desired.  Accepted values are Debug, Info, Warning
+and Error.
+@end table
+@end deftp
 
 @node Telephony Services
 @subsubsection Telephony Services
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 110800641..92f86a1b8 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -22,6 +22,8 @@
 (define-module (gnu services messaging)
   #:use-module (gnu packages messaging)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages irc)
+  #:use-module (gnu packages tls)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services configuration)
@@ -50,7 +52,10 @@
             bitlbee-configuration
             bitlbee-configuration?
             bitlbee-service
-            bitlbee-service-type))
+            bitlbee-service-type
+
+            quassel-configuration
+            quassel-service-type))
 
 ;;; Commentary:
 ;;;
@@ -895,3 +900,86 @@ configuration file."
             (bitlbee bitlbee)
             (interface interface) (port port)
             (extra-settings extra-settings))))
+
+\f
+;;;
+;;; Quassel.
+;;;
+
+(define-record-type* <quassel-configuration>
+  quassel-configuration make-quassel-configuration
+  quassel-configuration?
+  (quassel quassel-configuration-quassel
+           (default quassel))
+  (interface quassel-configuration-interface
+             (default "::,0.0.0.0"))
+  (port quassel-configuration-port
+        (default 4242))
+  (loglevel quassel-configuration-loglevel
+            (default "Info")))
+
+(define quassel-shepherd-service
+  (match-lambda
+    (($ <quassel-configuration> quassel interface port loglevel)
+     (with-imported-modules (source-module-closure
+                              '((gnu build shepherd)
+                                (gnu system file-systems)))
+       (list (shepherd-service
+               (provision '(quassel))
+               (requirement '(user-processes networking))
+               (modules '((gnu build shepherd)
+                          (gnu system file-systems)))
+               (start #~(make-forkexec-constructor/container
+                          (list #$(file-append quassel "/bin/quasselcore")
+                                "--configdir=/var/lib/quassel"
+                                "--logfile=/var/log/quassel/core.log"
+                                (string-append "--loglevel=" #$loglevel)
+                                (string-append "--port=" (number->string #$port))
+                                (string-append "--listen=" #$interface))
+                          #:mappings (list (file-system-mapping
+                                             (source "/var/lib/quassel")
+                                             (target source)
+                                             (writable? #t))
+                                           (file-system-mapping
+                                             (source "/var/log/quassel")
+                                             (target source)
+                                             (writable? #t)))))
+               (stop  #~(make-kill-destructor))))))))
+
+(define %quassel-account
+  (list (user-group (name "quassel") (system? #t))
+        (user-account
+          (name "quasselcore")
+          (group "quassel")
+          (system? #t)
+          (comment "Quassel daemon user")
+          (home-directory "/var/lib/quassel")
+          (shell (file-append shadow "/sbin/nologin")))))
+
+(define %quassel-activation
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/lib/quassel")
+      (mkdir-p "/var/log/quassel")
+      (let ((cert "/var/lib/quassel/quasselCert.pem"))
+        (unless (file-exists? cert)
+          (invoke #$(file-append openssl "/bin/openssl")
+                  "req" "-x509" "-nodes" "-batch" "-days" "680" "-newkey"
+                  "rsa" "-keyout" cert "-out" cert)))))
+
+(define quassel-service-type
+  (service-type (name 'quassel)
+                (extensions
+                  (list (service-extension shepherd-root-service-type
+                                           quassel-shepherd-service)
+                        (service-extension profile-service-type
+                                           (compose list quassel-configuration-quassel))
+                        (service-extension account-service-type
+                                           (const %quassel-account))
+                        (service-extension activation-service-type
+                                           (const %quassel-activation))))
+                (default-value (quassel-configuration))
+                (description
+                 "Run @url{https://quassel-irc.org/,quasselcore}, the backend
+for the distributed IRC client quassel, which allows you to connect from
+multiple machines simultaneously.")))
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index 36afb987a..176e3d08c 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,8 @@
   #:use-module (guix store)
   #:use-module (guix modules)
   #:export (%test-prosody
-            %test-bitlbee))
+            %test-bitlbee
+            %test-quassel))
 
 (define (run-xmpp-test name xmpp-service pid-file create-account)
   "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
@@ -239,3 +241,53 @@
    (name "bitlbee")
    (description "Connect to a BitlBee IRC server.")
    (value (run-bitlbee-test))))
+
+(define (run-quassel-test)
+  (define os
+    (marionette-operating-system
+      (simple-operating-system (service dhcp-client-service-type)
+                               (service quassel-service-type))
+     #:imported-modules (source-module-closure
+                         '((gnu services herd)))))
+
+  (define vm
+    (virtual-machine
+      (operating-system os)
+      (port-forwardings `((4242 . 4242)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "quassel")
+
+          (test-assert "service started"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'quassel))
+             marionette))
+
+          (test-assert "certificate file"
+            (marionette-eval
+              '(file-exists? "/var/lib/quassel/quasselCert.pem")
+              marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "quassel-test" test))
+
+(define %test-quassel
+  (system-test
+   (name "quassel")
+   (description "Connect to a quassel IRC server.")
+   (value (run-quassel-test))))
-- 
2.20.0