diff options
Diffstat (limited to 'gnu/services/messaging.scm')
| -rw-r--r-- | gnu/services/messaging.scm | 122 |
1 files changed, 82 insertions, 40 deletions
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 6ed55453db..48eff27b49 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> -;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2017-2020, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Pierre-Antoine Rouby <contact@parouby.fr> ;;; ;;; This file is part of GNU Guix. @@ -20,19 +20,23 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services messaging) - #:use-module (gnu packages messaging) #:use-module (gnu packages admin) + #:use-module (gnu packages base) #:use-module (gnu packages irc) + #:use-module (gnu packages messaging) #:use-module (gnu packages tls) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services configuration) #:use-module (gnu system shadow) + #:autoload (gnu build linux-container) (%namespaces) + #:use-module ((gnu system file-systems) #:select (file-system-mapping)) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix deprecation) + #:use-module (guix least-authority) #:use-module (srfi srfi-1) #:use-module (srfi srfi-35) #:use-module (ice-9 match) @@ -180,7 +184,7 @@ (and (list? val) (and-map file-name? val))) (define (serialize-file-name-list field-name val) (serialize-string-list field-name val)) -(define-maybe file-name) +(define-maybe file-name-list) (define (file-object? val) (or (file-like? val) (file-name? val))) @@ -192,7 +196,7 @@ (and (list? val) (and-map file-object? val))) (define (serialize-file-object-list field-name val) (serialize-string-list field-name val)) -(define-maybe file-object) +(define-maybe file-object-list) (define (raw-content? val) (not (eq? val 'disabled))) @@ -821,7 +825,23 @@ string, you could instantiate a prosody service like this: DaemonInterface = " interface " DaemonPort = " (number->string port) " PluginDir = " plugins "/lib/bitlbee -" extra-settings))) +" extra-settings)) + (bitlbee* (least-authority-wrapper + (file-append bitlbee "/sbin/bitlbee") + #:name "bitlbee" + #:preserved-environment-variables + '("PURPLE_PLUGIN_PATH" "GUIX_LOCPATH" "LC_ALL") + #:mappings (list (file-system-mapping + (source "/var/lib/bitlbee") + (target source) + (writable? #t)) + (file-system-mapping + (source "/run/current-system/locale") + (target source)) + (file-system-mapping + (source conf) + (target conf))) + #:namespaces (delq 'net %namespaces)))) (with-imported-modules (source-module-closure '((gnu build shepherd) @@ -836,21 +856,41 @@ string, you could instantiate a prosody service like this: (modules '((gnu build shepherd) (gnu system file-systems))) - (start #~(make-forkexec-constructor/container - (list #$(file-append bitlbee "/sbin/bitlbee") - "-n" "-F" "-u" "bitlbee" "-c" #$conf) - - ;; Allow 'bitlbee-purple' to use libpurple plugins. - #:environment-variables - (list (string-append "PURPLE_PLUGIN_PATH=" - #$plugins "/lib/purple-2")) - - #:pid-file "/var/run/bitlbee.pid" - #:mappings (list (file-system-mapping - (source "/var/lib/bitlbee") - (target source) - (writable? #t))))) - (stop #~(make-kill-destructor))))))))) + (start #~(if (defined? 'make-inetd-constructor) + + (make-inetd-constructor + (list #$bitlbee* "-I" "-c" #$conf) + (addrinfo:addr + (car (getaddrinfo #$interface + #$(number->string port) + (logior AI_NUMERICHOST + AI_NUMERICSERV)))) + #:service-name-stem "bitlbee" + #:user "bitlbee" #:group "bitlbee" + + ;; Allow 'bitlbee-purple' to use libpurple plugins. + #:environment-variables + (list (string-append "PURPLE_PLUGIN_PATH=" + #$plugins "/lib/purple-2") + "GUIX_LOCPATH=/run/current-system/locale")) + + (make-forkexec-constructor/container + (list #$(file-append bitlbee "/sbin/bitlbee") + "-n" "-F" "-u" "bitlbee" "-c" #$conf) + + ;; Allow 'bitlbee-purple' to use libpurple plugins. + #:environment-variables + (list (string-append "PURPLE_PLUGIN_PATH=" + #$plugins "/lib/purple-2")) + + #:pid-file "/var/run/bitlbee.pid" + #:mappings (list (file-system-mapping + (source "/var/lib/bitlbee") + (target source) + (writable? #t)))))) + (stop #~(if (defined? 'make-inetd-destructor) + (make-inetd-destructor) + (make-kill-destructor)))))))))) (define %bitlbee-accounts ;; User group and account to run BitlBee. @@ -908,29 +948,31 @@ a gateway between IRC and chat networks."))) (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))) + (let ((quassel (least-authority-wrapper + (file-append quassel "/bin/quasselcore") + #:name "quasselcore" + #:mappings (list (file-system-mapping + (source "/var/lib/quassel") + (target source) + (writable? #t)) + (file-system-mapping + (source "/var/log/quassel") + (target source) + (writable? #t))) + ;; XXX: The daemon needs to live in the main user + ;; namespace, as root, so it can access /var/lib/quassel + ;; owned by "quasselcore". + #:namespaces (fold delq %namespaces '(net user))))) (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))))) + (start #~(make-forkexec-constructor + (list #$quassel + "--configdir=/var/lib/quassel" + "--logfile=/var/log/quassel/core.log" + (string-append "--loglevel=" #$loglevel) + (string-append "--port=" (number->string #$port)) + (string-append "--listen=" #$interface)))) (stop #~(make-kill-destructor)))))))) (define %quassel-account |