01/01: services: Add quassel.

[guix-commits]

efraim pushed a commit to branch master
in repository guix.

commit dcad57d5fca43a111e1b314264171c80d4d9a75b
Author: Efraim Flashner <address@hidden>
Date:   Wed Dec 12 10:15:08 2018 +0200

    services: Add quassel.
    
    * 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 484a29f..2553ba7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -16298,6 +16298,37 @@ Configuration snippet added as-is to the BitlBee 
configuration file.
 @end table
 @end deftp
 
address@hidden Quassel Service
+
address@hidden IRC (Internet Relay Chat)
address@hidden://quassel-irc.org/,Quassel} is a distributed IRC client,
+meaning that one or more clients can attach to and detach from the
+central core.
+
address@hidden {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).
address@hidden defvr
+
address@hidden {Data Type} quassel-configuration
+This is the configuration for Quassel, with the following fields:
+
address@hidden @asis
address@hidden @code{quassel} (default: @code{quassel})
+The Quassel package to use.
+
address@hidden @code{interface} (default: @code{"::,0.0.0.0"})
address@hidden @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
address@hidden
+
address@hidden @code{loglevel} (default: @code{"Info"})
+The level of logging desired.  Accepted values are Debug, Info, Warning
+and Error.
address@hidden table
address@hidden deftp
 
 @node Telephony Services
 @subsubsection Telephony Services
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 1108006..92f86a1 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))))
+
+
+;;;
+;;; 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 36afb98..176e3d0 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 <address@hidden>
 ;;; Copyright © 2017, 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018 Efraim Flashner <address@hidden>
 ;;;
 ;;; 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))))