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>

3 files changed, 808 insertions, 0 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index bf9cb47478..b0d98252d2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -30901,6 +30901,219 @@ details.
 
 @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
 
 @cindex IRC (Internet Relay Chat)
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index adcc75dd1d..c13700f032 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -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
 
@@ -1639,6 +1673,355 @@ 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.
 ;;;
 
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index d17bce21ef..e004f160f9 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -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)
@@ -331,6 +335,214 @@
 
 
 ;;;
+;;; 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.
 ;;;