mirror of
https://codeberg.org/guix/guix.git
synced 2026-01-25 03:55:08 -06:00
services: pounce: New service.
* gnu/services/messaging.scm (pounce-serialize-boolean): (pounce-serialize-string, pounce-serialize-list-of-strings) (pounce-serialize-pair, power-of-two?) (pounce-serialize-number, pounce-serialize-power-of-two) (pounce-serialize-port, pounce-serialize-maybe-boolean) (pounce-serialize-maybe-number, pounce-serialize-maybe-pair) (pounce-serialize-maybe-port, pounce-serialize-maybe-port (pounce-maybe-power-of-two, pounce-serialize-maybe-string) (pounce-serialize-maybe-list-of-strings): New procedures. (pounce-configuration): New configuration. (pounce-activation): New procedure. (serialize-pounce-configuration, pounce-wrapper): Likewise. (pounce-service-type): New service type. * gnu/tests/messaging.scm (ngircd-tls-cert-service-type): New variable. (%pounce-os): Likewise. (run-pounce-test): New procedure. (%test-pounce): New test. * doc/guix.texi (Messaging Services): Document it. Change-Id: I4bbd2bc4821072a93c2c4017b86df329c4b240cb Reviewed-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Maxim Cournoyer
parent
367d071bba
commit
aab89b3d93
3 changed files with 808 additions and 0 deletions
213
doc/guix.texi
213
doc/guix.texi
|
|
@ -30899,6 +30899,219 @@ details.
|
|||
@end deftp
|
||||
|
||||
|
||||
@c %end of fragment
|
||||
|
||||
@subsubheading Pounce Service
|
||||
|
||||
@cindex IRC (Internet Relay Chat)
|
||||
@cindex bouncer, IRC
|
||||
@cindex Bounced Network Connection, BNC
|
||||
@url{https://git.causal.agency/pounce/about/, pounce} is a multi-client,
|
||||
TLS-only IRC bouncer. It maintains a persistent connection to an IRC
|
||||
server, acting as a proxy and buffer for a number of clients.
|
||||
|
||||
@defvar pounce-service-type
|
||||
This is the service type for the pounce IRC bouncer. Its value is a
|
||||
@code{pounce-configuration} configuration instance, which is documented
|
||||
below.
|
||||
|
||||
@cindex IRC bouncer configuration for Libera.Chat
|
||||
@cindex Libera.Chat, IRC bouncer configuration
|
||||
The following example configures pounce to act as an IRC bouncer for the
|
||||
@url{https://libera.chat, Libera.Chat} server, using @acronym{CertFP,
|
||||
client certificate fingerprint} authentication to avoid leaking a
|
||||
sensitive password to the publicly readable store. The equally
|
||||
sensitive TLS certificate file should be created in-place or transferred
|
||||
using a secure means such as SSH, prior to deploying the service. The
|
||||
service activation will ensure the ownership and permissions of the
|
||||
certificate/key files are set correctly. In the below example, it is
|
||||
placed at @file{/etc/pounce/libera.pem} on the target machine. Pounce
|
||||
itself can be used to generate a TLS certificate, using the @samp{pounce
|
||||
-g libera.pem} command, which concatenates both the private key and the
|
||||
public certificate in the specified file name. For more information
|
||||
regarding CertFP authentication, refer to @samp{man pounce} or the
|
||||
Libera.Chat guide at @url{https://libera.chat/guides/certfp}.
|
||||
|
||||
@lisp
|
||||
(service pounce-service-type
|
||||
(pounce-configuration
|
||||
(host "irc.libera.chat")
|
||||
(client-cert "/etc/pounce/libera.pem")
|
||||
(nick "hannah")
|
||||
(join (list "#gnu" "#guix" "#guile" "#hurd"))))
|
||||
@end lisp
|
||||
|
||||
Once deployed on the target machine, pounce will act as an IRC server
|
||||
listening for TLS connections on the 6697 TCP port of the
|
||||
@samp{localhost} address of that machine. By default, a self-signed
|
||||
certificate for pounce is created at
|
||||
@file{/var/lib/pounce/.config/pounce/localhost.cert}. If you plan to
|
||||
expose the bouncer to the public Internet, it is advisable to use a
|
||||
@acronym{CA, Certificate Authority}-signed certificate, as can be
|
||||
obtained using a certificate service (@pxref{Certificate Services}), so
|
||||
that IRC clients can verify the certificate out of the box. If you
|
||||
instead plan to connect to the bouncer strictly via a secure connection,
|
||||
for example using a @acronym{VPN, Virtual Private Network} or
|
||||
@acronym{SSH, Secure Shell}, then it is acceptable to simply let your
|
||||
IRC client trust the auto-generated, self-signed pounce certificate or
|
||||
even disable TLS certificate verification in your client.
|
||||
|
||||
@cindex IRC bouncer configuration for OFTC
|
||||
@cindex OFTC, IRC bouncer configuration
|
||||
To connect to a second server, a second pounce instance is needed,
|
||||
taking care to specify the @code{provision} field of its
|
||||
@code{pounce-configuration} to avoid a name clash with the previous
|
||||
service, along with a distinct @code{local-port} and @code{log-file}.
|
||||
The following example shows how to configure another bouncer, this time
|
||||
for the @url{https://www.oftc.net, OFTC} IRC server. Like in the
|
||||
previous example, CertFP authentication is used, which can be configured
|
||||
similarly. For more details about using CertFP with the OFTC IRC
|
||||
server, refer to @url{https://www.oftc.net/NickServ/CertFP/}.
|
||||
|
||||
@lisp
|
||||
(service pounce-service-type
|
||||
(pounce-configuration
|
||||
(shepherd-provision '(pounce-oftc))
|
||||
(local-port 6698)
|
||||
(log-file "/var/log/pounce-oftc.log")
|
||||
(host "irc.oftc.net")
|
||||
(client-cert "/etc/pounce/oftc.pem")
|
||||
(nick "sena")
|
||||
(join (list "#gcc" "#glibc"))))
|
||||
@end lisp
|
||||
|
||||
@end defvar
|
||||
|
||||
@c Auto-generated via (configuration->documentation 'pounce-configuration).
|
||||
@c %start of fragment
|
||||
|
||||
@deftp {Data Type} pounce-configuration
|
||||
Available @code{pounce-configuration} fields are:
|
||||
|
||||
@table @asis
|
||||
@item @code{pounce} (default: @code{pounce}) (type: file-like)
|
||||
The @code{pounce} package to use.
|
||||
|
||||
@item @code{shepherd-provision} (default: @code{(pounce)}) (type: list-of-symbols)
|
||||
The name(s) of the service.
|
||||
|
||||
@item @code{shepherd-requirement} (default: @code{(user-processes networking)}) (type: list-of-symbols)
|
||||
Shepherd requirements the service should depend on.
|
||||
|
||||
@item @code{log-file} (default: @code{"/var/log/pounce.log"}) (type: string)
|
||||
The log file name to use.
|
||||
|
||||
@item @code{verbose?} (type: maybe-boolean)
|
||||
When true, log IRC messages to standard output.
|
||||
|
||||
@item @code{local-host} (default: @code{"localhost"}) (type: maybe-string)
|
||||
The host to bind to.
|
||||
|
||||
@item @code{local-port} (default: @code{6697}) (type: maybe-port)
|
||||
The port to bind to.
|
||||
|
||||
@item @code{local-ca} (type: maybe-string)
|
||||
Require clients to authenticate using a TLS client certificate either
|
||||
contained in or signed by a certificate in the file loaded from
|
||||
@code{local-ca}, a file name. The file is reloaded when the SIGUSR1
|
||||
signal is received.
|
||||
|
||||
@item @code{local-cert} (type: maybe-string)
|
||||
File name of the TLS certificate to load. The file is reloaded when the
|
||||
SIGUSR1 signal is received. Unless specified, a self-signed certificate
|
||||
is generated at @file{/var/lib/pounce/.config/pounce/@var{host}.pem},
|
||||
where @var{host} corresponds to the value of the @code{local-host}
|
||||
field.
|
||||
|
||||
@item @code{local-priv} (type: maybe-string)
|
||||
File name of the private TLS key to load. Unless specified, a key is
|
||||
generated at @file{/var/lib/pounce/.config/pounce/@var{host}.key}, where
|
||||
@var{host} corresponds to the value of the @code{local-host} field.
|
||||
|
||||
@item @code{local-pass} (type: maybe-string)
|
||||
Require the server password pass for clients to connect. The pass
|
||||
string must be hashed using @samp{pounce -x}.
|
||||
|
||||
@item @code{size} (default: @code{4096}) (type: maybe-power-of-two)
|
||||
Set the number of messages contained in the buffer to @var{size}. This
|
||||
sets the maximum number of recent messages which can be relayed to a
|
||||
reconnecting client. The size must be a power of two.
|
||||
|
||||
@item @code{bind} (type: maybe-string)
|
||||
Host to bind the @emph{source} address to when connecting to the server.
|
||||
To connect from any address over IPv4 only, use @samp{0.0.0.0}. To
|
||||
connect from any address over IPv6 only, use @samp{::}.
|
||||
|
||||
@item @code{host} (type: string)
|
||||
The host name to connect to.
|
||||
|
||||
@item @code{port} (type: maybe-port)
|
||||
The port number to connect to.
|
||||
|
||||
@item @code{pass} (type: maybe-string)
|
||||
Password to use to log in with the server. The password must have been
|
||||
hashed via the @samp{pounce -x} command.
|
||||
|
||||
@item @code{join} (type: maybe-list-of-strings)
|
||||
The list of channels to join.
|
||||
|
||||
@item @code{mode} (type: maybe-string)
|
||||
The user mode.
|
||||
|
||||
@item @code{user} (type: maybe-string)
|
||||
To set the username. The default username is the same as the nickname.
|
||||
|
||||
@item @code{nick} (default: @code{"pounce"}) (type: maybe-string)
|
||||
Set nickname to @var{nick}.
|
||||
|
||||
@item @code{real} (type: maybe-string)
|
||||
Set the real name. The default is @code{nick}.
|
||||
|
||||
@item @code{away} (type: maybe-string)
|
||||
The away status to use when no clients are connected and no other away
|
||||
status has been set.
|
||||
|
||||
@item @code{quit} (type: maybe-string)
|
||||
The message to use when quitting.
|
||||
|
||||
@item @code{no-names?} (type: maybe-boolean)
|
||||
Do not request @samp{NAMES} for each channel when a client connects.
|
||||
This avoids already connected clients receiving unsolicited responses
|
||||
but prevents new clients from populating user lists.
|
||||
|
||||
@item @code{queue-interval} (default: @code{200}) (type: maybe-number)
|
||||
Set the server send queue interval in milliseconds. The queue is used
|
||||
to send automated messages from pounce to the server. Messages from
|
||||
clients are sent to the server directly.
|
||||
|
||||
@item @code{trust} (type: maybe-string)
|
||||
File name of a certificate to trust. When used, server name
|
||||
verification is disabled.
|
||||
|
||||
@item @code{client-cert} (type: maybe-string)
|
||||
The file name of the TLS client. If the private key is in a separate
|
||||
file, it is loaded with @code{client-priv}. With @code{sasl-external?},
|
||||
authenticate using SASL EXTERNAL. Certificates can be generated with
|
||||
@samp{pounce -g}. For more details, refer to ``Generating Client
|
||||
Certificates'' in @samp{man 1 pounce}.
|
||||
|
||||
@item @code{client-priv} (type: maybe-string)
|
||||
The file name of the TLS client private key.
|
||||
|
||||
@item @code{sasl-plain} (type: maybe-pair)
|
||||
A pair of the username and password in plain text to authenticate using
|
||||
SASL PLAIN. Since this method requires the account password in plain
|
||||
text, it is recommended to use CertFP instead with @code{sasl-external}.
|
||||
|
||||
@item @code{sasl-external?} (type: maybe-boolean)
|
||||
Authenticate using SASL EXTERNAL, also known as CertFP. The TLS client
|
||||
certificate is loaded from @code{client-cert}.
|
||||
|
||||
@end table
|
||||
|
||||
@end deftp
|
||||
|
||||
|
||||
@c %end of fragment
|
||||
|
||||
@subsubheading Quassel Service
|
||||
|
|
|
|||
|
|
@ -149,6 +149,40 @@
|
|||
ngircd-channel-modes
|
||||
ngircd-channel-key-file
|
||||
|
||||
pounce-configuration
|
||||
pounce-configuration-pounce
|
||||
pounce-configuration-shepherd-provision
|
||||
pounce-configuration-shepherd-requirement
|
||||
pounce-configuration-log-file
|
||||
pounce-configuration-verbose?
|
||||
pounce-configuration-local-host
|
||||
pounce-configuration-local-port
|
||||
pounce-configuration-local-ca
|
||||
pounce-configuration-local-cert
|
||||
pounce-configuration-local-priv
|
||||
pounce-configuration-local-pass
|
||||
pounce-configuration-size
|
||||
pounce-configuration-bind
|
||||
pounce-configuration-host
|
||||
pounce-configuration-port
|
||||
pounce-configuration-pass
|
||||
pounce-configuration-join
|
||||
pounce-configuration-mode
|
||||
pounce-configuration-user
|
||||
pounce-configuration-nick
|
||||
pounce-configuration-real
|
||||
pounce-configuration-away
|
||||
pounce-configuration-quit
|
||||
pounce-configuration-no-names?
|
||||
pounce-configuration-queue-interval
|
||||
pounce-configuration-trust
|
||||
pounce-configuration-client-cert
|
||||
pounce-configuration-client-priv
|
||||
pounce-configuration-sasl-plain
|
||||
pounce-configuration-sasl-external?
|
||||
|
||||
pounce-service-type
|
||||
|
||||
quassel-configuration
|
||||
quassel-service-type
|
||||
|
||||
|
|
@ -1637,6 +1671,355 @@ wrapper for the 'ngircd' command."
|
|||
"Run @url{https://ngircd.barton.de/, ngIRCd}, a lightweight @acronym{IRC,
|
||||
Internet Relay Chat} daemon.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Pounce.
|
||||
;;;
|
||||
(define (pounce-serialize-boolean field value)
|
||||
"Boolean arguments for pounce serialize to their field name, minus the
|
||||
trailing '?'."
|
||||
(let ((name (symbol->string field)))
|
||||
(string-append (if (string-suffix? "?" name)
|
||||
(string-drop-right name 1)
|
||||
name)
|
||||
"\n")))
|
||||
|
||||
(define (pounce-serialize-string field value)
|
||||
(format #f "~a=~a~%" field value))
|
||||
|
||||
(define (pounce-serialize-list-of-strings field value)
|
||||
(format #f "~a=~{~a~^,~}~%" field value))
|
||||
|
||||
(define (pounce-serialize-pair field value)
|
||||
(match value
|
||||
((head . tail)
|
||||
(format #f "~a=~a:~a~%" field head tail))))
|
||||
|
||||
(define (power-of-two? x)
|
||||
"Predicate to check if X is an exact power of two."
|
||||
(exact-integer? (sqrt x)))
|
||||
|
||||
(define pounce-serialize-number pounce-serialize-string)
|
||||
(define pounce-serialize-power-of-two pounce-serialize-number)
|
||||
(define pounce-serialize-port pounce-serialize-number)
|
||||
|
||||
(define-maybe boolean (prefix pounce-))
|
||||
(define-maybe number (prefix pounce-))
|
||||
(define-maybe pair (prefix pounce-))
|
||||
(define-maybe port (prefix pounce-))
|
||||
(define-maybe power-of-two (prefix pounce-))
|
||||
(define-maybe string (prefix pounce-))
|
||||
(define-maybe list-of-strings (prefix pounce-))
|
||||
|
||||
;;; For a reference w.r.t. which options require an argument, refer to the
|
||||
;;; `options' array defined in bounce.c.
|
||||
(define-configuration pounce-configuration
|
||||
(pounce
|
||||
(file-like pounce)
|
||||
"The @code{pounce} package to use."
|
||||
(serializer empty-serializer))
|
||||
|
||||
(shepherd-provision
|
||||
(list-of-symbols '(pounce))
|
||||
"The name(s) of the service."
|
||||
(serializer empty-serializer))
|
||||
|
||||
(shepherd-requirement
|
||||
(list-of-symbols '(user-processes networking))
|
||||
"Shepherd requirements the service should depend on."
|
||||
(serializer empty-serializer))
|
||||
|
||||
(log-file
|
||||
(string "/var/log/pounce.log")
|
||||
"The log file name to use."
|
||||
(serializer empty-serializer))
|
||||
|
||||
(verbose?
|
||||
maybe-boolean
|
||||
"When true, log IRC messages to standard output.")
|
||||
|
||||
;; Client options.
|
||||
(local-host
|
||||
(maybe-string "localhost")
|
||||
"The host to bind to.")
|
||||
|
||||
(local-port
|
||||
(maybe-port 6697)
|
||||
"The port to bind to.")
|
||||
|
||||
(local-ca
|
||||
maybe-string
|
||||
"Require clients to authenticate using a TLS client certificate either
|
||||
contained in or signed by a certificate in the file loaded from
|
||||
@code{local-ca}, a file name. The file is reloaded when the SIGUSR1 signal is
|
||||
received.")
|
||||
|
||||
(local-cert
|
||||
maybe-string
|
||||
"File name of the TLS certificate to load. The file is reloaded when the
|
||||
SIGUSR1 signal is received. Unless specified, a self-signed certificate is
|
||||
generated at @file{/var/lib/pounce/.config/pounce/@var{host}.pem}, where
|
||||
@var{host} corresponds to the value of the @code{local-host} field.")
|
||||
|
||||
(local-priv
|
||||
maybe-string
|
||||
"File name of the private TLS key to load. Unless specified, a key is
|
||||
generated at @file{/var/lib/pounce/.config/pounce/@var{host}.key}, where
|
||||
@var{host} corresponds to the value of the @code{local-host} field.")
|
||||
|
||||
(local-pass
|
||||
maybe-string
|
||||
"Require the server password pass for clients to connect. The pass string
|
||||
must be hashed using @samp{pounce -x}.")
|
||||
|
||||
(size
|
||||
(maybe-power-of-two 4096)
|
||||
"Set the number of messages contained in the buffer to @var{size}. This
|
||||
sets the maximum number of recent messages which can be relayed to a
|
||||
reconnecting client. The size must be a power of two.")
|
||||
|
||||
;; Server options.
|
||||
(bind
|
||||
maybe-string
|
||||
"Host to bind the @emph{source} address to when connecting to the server.
|
||||
To connect from any address over IPv4 only, use @samp{0.0.0.0}. To connect
|
||||
from any address over IPv6 only, use @samp{::}." )
|
||||
|
||||
(host
|
||||
string
|
||||
"The host name to connect to.")
|
||||
|
||||
(port
|
||||
maybe-port
|
||||
"The port number to connect to.")
|
||||
|
||||
(pass
|
||||
maybe-string
|
||||
"Password to use to log in with the server. The password must have been
|
||||
hashed via the @samp{pounce -x} command.")
|
||||
|
||||
(join
|
||||
maybe-list-of-strings
|
||||
"The list of channels to join.")
|
||||
|
||||
(mode maybe-string "The user mode.")
|
||||
|
||||
(user
|
||||
maybe-string
|
||||
"To set the username. The default username is the same as the nickname.")
|
||||
|
||||
(nick
|
||||
(maybe-string "pounce")
|
||||
"Set nickname to @var{nick}.")
|
||||
|
||||
(real
|
||||
maybe-string
|
||||
"Set the real name. The default is @code{nick}.")
|
||||
|
||||
(away
|
||||
maybe-string
|
||||
"The away status to use when no clients are connected and no other away
|
||||
status has been set.")
|
||||
|
||||
(quit
|
||||
maybe-string
|
||||
"The message to use when quitting.")
|
||||
|
||||
(no-names?
|
||||
maybe-boolean
|
||||
"Do not request @samp{NAMES} for each channel when a client connects. This
|
||||
avoids already connected clients receiving unsolicited responses but prevents
|
||||
new clients from populating user lists.")
|
||||
|
||||
(queue-interval
|
||||
(maybe-number 200)
|
||||
"Set the server send queue interval in milliseconds. The queue is used to
|
||||
send automated messages from pounce to the server. Messages from clients are
|
||||
sent to the server directly.")
|
||||
|
||||
(trust
|
||||
maybe-string
|
||||
"File name of a certificate to trust. When used, server name verification
|
||||
is disabled.")
|
||||
|
||||
(client-cert
|
||||
maybe-string
|
||||
"The file name of the TLS client. If the private key is in a separate
|
||||
file, it is loaded with @code{client-priv}. With @code{sasl-external?},
|
||||
authenticate using SASL EXTERNAL. Certificates can be generated with
|
||||
@samp{pounce -g}. For more details, refer to ``Generating Client
|
||||
Certificates'' in @samp{man 1 pounce}.")
|
||||
|
||||
(client-priv
|
||||
maybe-string
|
||||
"The file name of the TLS client private key.")
|
||||
|
||||
(sasl-plain
|
||||
maybe-pair
|
||||
"A pair of the username and password in plain text to authenticate using
|
||||
SASL PLAIN. Since this method requires the account password in plain text, it
|
||||
is recommended to use CertFP instead with @code{sasl-external}.")
|
||||
|
||||
(sasl-external?
|
||||
maybe-boolean
|
||||
"Authenticate using SASL EXTERNAL, also known as CertFP. The TLS client
|
||||
certificate is loaded from @code{client-cert}.")
|
||||
(prefix pounce-))
|
||||
|
||||
(define %pounce-account
|
||||
(list (user-group (name "pounce") (system? #t))
|
||||
(user-account
|
||||
(name "pounce")
|
||||
(group "pounce")
|
||||
(system? #t)
|
||||
(comment "Pounce daemon user")
|
||||
(home-directory "/var/lib/pounce")
|
||||
(shell (file-append shadow "/sbin/nologin")))))
|
||||
|
||||
(define (pounce-activation config)
|
||||
"Create the HOME directory for pounce as well as the default TLS certificate
|
||||
and key, if not explicitly provided."
|
||||
(match-record config <pounce-configuration>
|
||||
( local-host local-ca local-cert local-priv
|
||||
trust client-cert client-priv)
|
||||
(with-imported-modules (source-module-closure
|
||||
'((gnu build activation)))
|
||||
#~(begin
|
||||
(use-modules (gnu build activation)
|
||||
(srfi srfi-34))
|
||||
|
||||
(let* ((home "/var/lib/pounce")
|
||||
(user (getpwnam "pounce"))
|
||||
(confdir (string-append home "/.config/pounce"))
|
||||
(default-cert (string-append confdir "/" #$local-host ".pem"))
|
||||
(default-key (string-append confdir "/" #$local-host ".key")))
|
||||
|
||||
(define* (sanitize-permissions file #:optional (mode #o400))
|
||||
(guard (c (#t #t))
|
||||
(chown file (passwd:uid user) (passwd:gid user))
|
||||
(chmod file mode)))
|
||||
|
||||
;; Create home directory for pounce user.
|
||||
(mkdir-p/perms home user #o755)
|
||||
|
||||
;; Best effort at sanitizing the ownership/permissions of the
|
||||
;; certificate/keys. Since a cert file may incorporate the
|
||||
;; security key, keep the permissions as tight as possible (owner
|
||||
;; read-only / #o400).
|
||||
(when #$(maybe-value-set? local-ca)
|
||||
(sanitize-permissions #$local-ca))
|
||||
(if #$(maybe-value-set? local-cert)
|
||||
(sanitize-permissions #$local-cert)
|
||||
(sanitize-permissions default-cert))
|
||||
(if #$(maybe-value-set? local-priv)
|
||||
(sanitize-permissions #$local-priv)
|
||||
(sanitize-permissions default-key))
|
||||
(when #$(maybe-value-set? trust)
|
||||
(sanitize-permissions #$trust))
|
||||
(when #$(maybe-value-set? client-cert)
|
||||
(sanitize-permissions #$client-cert))
|
||||
(when #$(maybe-value-set? client-priv)
|
||||
(sanitize-permissions #$client-priv))
|
||||
|
||||
;; Generate a default self-signed TLS certificate and private key
|
||||
;; unless explicitly provided.
|
||||
(unless #$(maybe-value-set? local-cert)
|
||||
(unless (file-exists? default-cert)
|
||||
(mkdir-p/perms confdir user #o755)
|
||||
(let ((openssl #$(file-append openssl "/bin/openssl"))
|
||||
(args `("req" "-newkey" "rsa" "-x509" "-days" "3650"
|
||||
"-noenc" "-subj" "/C=CA/CN=Pounce Certificate"
|
||||
,@(if #$(maybe-value-set? local-priv)
|
||||
'() ;XXX: likely bogus case
|
||||
(list "-keyout" default-key))
|
||||
"-out" ,default-cert)))
|
||||
|
||||
;; XXX: Manually guard against and report exceptions until
|
||||
;; bug#77365 is addressed.
|
||||
(guard (c ((invoke-error? c)
|
||||
(format (current-error-port)
|
||||
"pounce: error generating pounce tls \
|
||||
certificate: ~a~%" c)))
|
||||
(apply invoke openssl args))
|
||||
(sanitize-permissions default-cert #o444)
|
||||
(unless #$(maybe-value-set? local-priv)
|
||||
(sanitize-permissions default-key #o400))))))))))
|
||||
|
||||
(define (serialize-pounce-configuration config)
|
||||
"Return a file-like object corresponding to the serialized CONFIG
|
||||
<pounce-configuration> record."
|
||||
(mixed-text-file "pounce.conf"
|
||||
(serialize-configuration config
|
||||
pounce-configuration-fields)))
|
||||
|
||||
(define (pounce-wrapper config)
|
||||
"Take CONFIG, a <pounce-configuration> object, and provide a least-authority
|
||||
wrapper for the 'ngircd' command."
|
||||
(match-record config <pounce-configuration>
|
||||
(local-ca local-cert local-priv trust client-cert client-priv)
|
||||
(let* ((pounce.conf (serialize-pounce-configuration config)))
|
||||
(least-authority-wrapper
|
||||
(file-append (pounce-configuration-pounce config) "/bin/pounce")
|
||||
#:name "pounce-pola-wrapper"
|
||||
;; Expose all needed files, such as options corresponding to string
|
||||
;; file names.
|
||||
#:mappings
|
||||
(append
|
||||
(list (file-system-mapping
|
||||
(source pounce.conf)
|
||||
(target source))
|
||||
(file-system-mapping
|
||||
(source "/var/lib/pounce")
|
||||
(target source)
|
||||
(writable? #t))
|
||||
(file-system-mapping
|
||||
(source "/var/log/pounce.log")
|
||||
(target source)
|
||||
(writable? #t)))
|
||||
(filter-map (lambda (value)
|
||||
(if (maybe-value-set? value)
|
||||
(file-system-mapping
|
||||
(source value)
|
||||
(target source))
|
||||
#f))
|
||||
(list local-ca local-cert local-priv
|
||||
trust client-cert client-priv)))
|
||||
#:user "pounce"
|
||||
#:group "pounce"
|
||||
#:preserved-environment-variables
|
||||
(cons "HOME" %default-preserved-environment-variables)
|
||||
;; Without preserving the user namespace, pounce fails to access the
|
||||
;; provisioned TLS certificates due to permission errors.
|
||||
#:namespaces (fold delq %namespaces '(net user))))))
|
||||
|
||||
(define (pounce-shepherd-service config)
|
||||
(let ((pounce.cfg (serialize-pounce-configuration config)))
|
||||
(list (shepherd-service
|
||||
(provision (pounce-configuration-shepherd-provision config))
|
||||
(requirement (pounce-configuration-shepherd-requirement config))
|
||||
(actions (list (shepherd-configuration-action pounce.cfg)))
|
||||
(start #~(make-forkexec-constructor
|
||||
(list #$(pounce-wrapper config) #$pounce.cfg)
|
||||
#:environment-variables (list "HOME=/var/lib/pounce")
|
||||
#:log-file #$(pounce-configuration-log-file config)))
|
||||
(stop #~(make-kill-destructor))))))
|
||||
|
||||
(define pounce-service-type
|
||||
(service-type
|
||||
(name 'pounce)
|
||||
(extensions
|
||||
(list (service-extension shepherd-root-service-type
|
||||
pounce-shepherd-service)
|
||||
(service-extension profile-service-type
|
||||
(compose list pounce-configuration-pounce))
|
||||
(service-extension account-service-type
|
||||
(const %pounce-account))
|
||||
(service-extension activation-service-type
|
||||
pounce-activation)))
|
||||
(description
|
||||
"Run @url{https://git.causal.agency/pounce/about/, pounce},
|
||||
the IRC bouncer.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Quassel.
|
||||
|
|
|
|||
|
|
@ -27,16 +27,20 @@
|
|||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services messaging)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module (gnu services ssh)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages irc)
|
||||
#:use-module (gnu packages messaging)
|
||||
#:use-module (gnu packages screen)
|
||||
#:use-module (gnu packages tls)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix modules)
|
||||
#:export (%test-prosody
|
||||
%test-bitlbee
|
||||
%test-ngircd
|
||||
%test-pounce
|
||||
%test-quassel))
|
||||
|
||||
(define (run-xmpp-test name xmpp-service pid-file create-account)
|
||||
|
|
@ -329,6 +333,214 @@
|
|||
(description "Connect to a ngircd IRC server.")
|
||||
(value (run-ngircd-test))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Pounce.
|
||||
;;;
|
||||
|
||||
;;; Code to generate a self-signed TLS certificate/private key for ngIRCd.
|
||||
;;; The ngIRCd certificate must be added to pounce's 'trust' file so that it
|
||||
;;; is trusted. It is deployed via a one-shot shepherd service required by
|
||||
;;; ngircd, which avoids having to allow file-like objects in the ngircd-ssl
|
||||
;;; configuration record (which would be unsafe as the store is public).
|
||||
(define ngircd-tls-cert-service-type
|
||||
(shepherd-service-type
|
||||
'ngircd-tls-cert
|
||||
(lambda _
|
||||
(shepherd-service
|
||||
(documentation "Generate TLS certificate/key for ngIRCd")
|
||||
(modules (append '((gnu build activation)
|
||||
(srfi srfi-26))
|
||||
%default-modules))
|
||||
(provision '(ngircd-tls-cert))
|
||||
(start
|
||||
(with-imported-modules (source-module-closure
|
||||
'((gnu build activation)))
|
||||
#~(lambda _
|
||||
(let ((certtool #$(file-append gnutls "/bin/certtool"))
|
||||
(user (getpwnam "ngircd")))
|
||||
(mkdir-p/perms "/etc/ngircd" user #o755)
|
||||
(call-with-output-file "/tmp/template"
|
||||
(cut format <> "expiration_days = -1~%"))
|
||||
;; XXX: Beware, chdir + invoke do not work together in Shepherd
|
||||
;; services (see bug#77707).
|
||||
(invoke certtool "--generate-privkey"
|
||||
"--outfile" "/etc/ngircd/ca-key.pem")
|
||||
(invoke certtool "--generate-self-signed"
|
||||
"--load-privkey" "/etc/ngircd/ca-key.pem"
|
||||
"--outfile" "/etc/ngircd/ca-cert.pem"
|
||||
"--template" "/tmp/template")
|
||||
(chdir "/etc/ngircd")
|
||||
(chown "ca-key.pem" (passwd:uid user) (passwd:gid user))
|
||||
(chmod "ca-key.pem" #o400)
|
||||
(chown "ca-cert.pem" (passwd:uid user) (passwd:gid user))
|
||||
(chmod "ca-cert.pem" #o444)
|
||||
(delete-file "/tmp/template")
|
||||
#t))))
|
||||
(one-shot? #t)))
|
||||
#t ;dummy default value
|
||||
(description "Generate a self-signed TLS certificate for ngIRCd")))
|
||||
|
||||
;;; To generate a VM image to test with, run:
|
||||
;;; guix system vm -e '(@@ (gnu tests messaging) %pounce-os)' --no-graphic
|
||||
;;; After login, resize tty to your needs, e.g.: 'stty rows 52 columns 234'
|
||||
(define %pounce-os
|
||||
(operating-system
|
||||
(inherit %simple-os)
|
||||
(packages
|
||||
(append (specifications->packages
|
||||
'("ii" "socat"
|
||||
;; Uncomment for debugging.
|
||||
;; "gdb"
|
||||
;; "gnutls" ;for gnutls-cli
|
||||
;; "screen"
|
||||
;; "strace"
|
||||
;; "ngircd:debug"
|
||||
;; "pounce:debug"
|
||||
;; "libressl:debug"
|
||||
;; "gnutls:debug"
|
||||
))
|
||||
%base-packages))
|
||||
(services
|
||||
(cons*
|
||||
(service dhcp-client-service-type)
|
||||
(service ngircd-tls-cert-service-type)
|
||||
(service ngircd-service-type
|
||||
(ngircd-configuration
|
||||
(debug? #t)
|
||||
(shepherd-requirement '(user-processes ngircd-tls-cert))
|
||||
(ssl (ngircd-ssl
|
||||
(ports (list 6697))
|
||||
(cert-file "/etc/ngircd/ca-cert.pem")
|
||||
(key-file "/etc/ngircd/ca-key.pem")))
|
||||
(channels (list (ngircd-channel (name "#irc"))))))
|
||||
(service pounce-service-type
|
||||
(pounce-configuration
|
||||
(host "localhost") ;connect to ngIRCd server
|
||||
;; Trust the IRC server self-signed certificate.
|
||||
(trust "/etc/ngircd/ca-cert.pem")
|
||||
(verbose? #t)
|
||||
;; The password below was generated by inputting 1234 at the
|
||||
;; prompt requested by 'pounce -x'.
|
||||
(local-pass "\
|
||||
$6$rviyVy+iFC9vT37o$2RUAhhFzD8gklXRk9X5KuHYtp6APk8nEXf1uroY2/KlgO9nQ0O/Dj05fzJ\
|
||||
/qNlpJQOijJMOyKm4fXjw.Ck9F91")
|
||||
(local-port 7000) ;listen on port 7000
|
||||
(nick "apteryx")
|
||||
(join (list "#irc"))))
|
||||
%base-services))))
|
||||
|
||||
(define (run-pounce-test)
|
||||
(define vm
|
||||
(virtual-machine
|
||||
(operating-system
|
||||
(marionette-operating-system
|
||||
%pounce-os
|
||||
#:imported-modules (source-module-closure
|
||||
'((gnu build dbus-service)
|
||||
(guix build utils)
|
||||
(gnu services herd)))))
|
||||
(memory-size 1024)))
|
||||
|
||||
(define test
|
||||
(with-imported-modules '((gnu build marionette))
|
||||
#~(begin
|
||||
(use-modules (srfi srfi-64)
|
||||
(gnu build marionette))
|
||||
|
||||
(define marionette
|
||||
(make-marionette (list #$vm)))
|
||||
|
||||
(test-runner-current (system-test-runner #$output))
|
||||
(test-begin "pounce")
|
||||
|
||||
(test-assert "IRC test server listens on TCP port 6697"
|
||||
(wait-for-tcp-port 6697 marionette))
|
||||
|
||||
(test-assert "pounce service runs"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(wait-for-service 'pounce))
|
||||
marionette))
|
||||
|
||||
(test-assert "pounce listens on TCP port 7000"
|
||||
(wait-for-tcp-port 7000 marionette))
|
||||
|
||||
(test-assert "pounce functions as an irc bouncer"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules ((gnu build dbus-service) #:select (with-retries))
|
||||
(guix build utils)
|
||||
(ice-9 textual-ports))
|
||||
|
||||
(define (write-command command)
|
||||
(call-with-output-file "in"
|
||||
(lambda (port)
|
||||
(display (string-append command "\n") port))))
|
||||
|
||||
(define (grep-output text)
|
||||
(with-retries 5 1 ;retry for 5 seconds
|
||||
(string-contains (call-with-input-file "out" get-string-all)
|
||||
(pk 'output-text: text))))
|
||||
|
||||
(define (connect-to-ngircd)
|
||||
(mkdir-p "/tmp/pounce")
|
||||
(unless (zero? (system "ii -s localhost -i /tmp/ngircd \
|
||||
-n ayoli &"))
|
||||
(error "error connecting to irc server"))
|
||||
(with-retries 5 1 (file-exists? "/tmp/ngircd/localhost"))
|
||||
(with-directory-excursion "/tmp/ngircd/localhost"
|
||||
(write-command "/join #irc"))
|
||||
(with-retries 5 1
|
||||
(file-exists? "/tmp/ngircd/localhost/#irc")))
|
||||
|
||||
(define (connect-to-pounce)
|
||||
(mkdir-p "/tmp/pounce")
|
||||
;; Expose a tunnel encrypting communication via TLS to
|
||||
;; pounce (mandated by pounce but supported by ii).
|
||||
(system "socat UNIX-LISTEN:/tmp/pounce/socket \
|
||||
OPENSSL:localhost:7000,verify=0 &")
|
||||
(with-retries 5 1 (file-exists? "/tmp/pounce/socket"))
|
||||
(setenv "PASS" "1234")
|
||||
(unless (zero? (system "ii -s localhost -i /tmp/pounce \
|
||||
-u /tmp/pounce/socket -n apteryx -k PASS &"))
|
||||
(error "error connecting to pounce server"))
|
||||
(with-retries 5 1 (file-exists? "/tmp/pounce/localhost"))
|
||||
(with-directory-excursion "/tmp/pounce/localhost"
|
||||
(write-command "/join #irc"))
|
||||
(with-retries 5 1
|
||||
(file-exists? "/tmp/pounce/localhost/#irc")))
|
||||
|
||||
(connect-to-ngircd)
|
||||
(connect-to-pounce)
|
||||
|
||||
;; Send a message via pounce.
|
||||
(with-directory-excursion "/tmp/pounce/localhost/#irc"
|
||||
(write-command "hi! Does pounce work well as a bouncer?")
|
||||
(write-command "/quit"))
|
||||
|
||||
;; Someone replied while we were away.
|
||||
(with-directory-excursion "/tmp/ngircd/localhost/#irc"
|
||||
(write-command "apteryx: pounce does work well"))
|
||||
|
||||
;; We reconnect some time later and receive the missed
|
||||
;; message.
|
||||
(with-retries 5 1 (not (file-exists? "/tmp/pounce/socket")))
|
||||
(connect-to-pounce)
|
||||
(with-directory-excursion "/tmp/pounce/localhost/#irc"
|
||||
(grep-output "apteryx: pounce does work well")))
|
||||
marionette))
|
||||
(test-end))))
|
||||
|
||||
(gexp->derivation "pounce-test" test))
|
||||
|
||||
(define %test-pounce
|
||||
(system-test
|
||||
(name "pounce")
|
||||
(description "Connect to a pounce IRC network bouncer.")
|
||||
(value (run-pounce-test))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Quassel.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue