GNU bug report logs - #77922
[PATCH] services: pounce: New service.

Previous Next

To reply to this bug, email your comments to 77922 AT debbugs.gnu.org.
There is no need to reopen the bug first.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: guix-patches <at> gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: [PATCH] services: pounce: New service.
Date: Sat, 19 Apr 2025 21:25:03 +0900

* 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
---
 doc/guix.texi              | 212 ++++++++++++++++++++
 gnu/services/messaging.scm | 382 +++++++++++++++++++++++++++++++++++++
 gnu/tests/messaging.scm    | 212 ++++++++++++++++++++
 3 files changed, 806 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 070528667fa..eb64089f0b7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -30791,6 +30791,218 @@ Messaging Services
 @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
+          (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)}) (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
+@{local-ca
+
+@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
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 2a93d42bf2a..2e006f0e448 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -149,6 +149,40 @@ (define-module (gnu services messaging)
             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,354 @@ (define ngircd-service-type
     "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))
+   "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 @{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 d17bce21ef9..e004f160f96 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -27,16 +27,20 @@ (define-module (gnu tests messaging)
   #: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 @@ (define %test-ngircd
    (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.

base-commit: 7686fe9d4fa1c40fd78e2ed57c60531c94bc9fd7
-- 
2.49.0

Message #8 received at 77922 <at> debbugs.gnu.org (full text, mbox):

From: jgart <jgart <at> dismail.de>
To: 77922 <at> debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Subject: Re: [PATCH] services: pounce: New service.
Date: Sat, 19 Apr 2025 08:46:05 -0500

Oh, this is really nice!

Message #11 received at 77922 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Cc: 77922 <at> debbugs.gnu.org
Subject: Re: [bug#77922] [PATCH] services: pounce: New service.
Date: Sat, 19 Apr 2025 22:50:02 +0200

Hello,

Maxim Cournoyer <maxim.cournoyer <at> gmail.com> writes:

> * 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

I had a quick look and this looks great to me.

Minor issues:

> +@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
> +@{local-ca

There’s a bug here: the line is truncated and markup is bogus.

Also maybe “local-certificate-authorities”?

> +@item @code{local-cert} (type: maybe-string)

“local-certificate”?

> +@item @code{local-priv} (type: maybe-string)

“local-private-key”

> +@item @code{client-cert} (type: maybe-string)

[...]

> +@item @code{client-priv} (type: maybe-string)

Likewise.

Thanks,
Ludo’.

Message #16 received at 77922-done <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 77922-done <at> debbugs.gnu.org, Jorge Gomez <jgart <at> dismail.de>
Subject: Re: [bug#77922] [PATCH] services: pounce: New service.
Date: Tue, 22 Apr 2025 11:38:07 +0900

Hi Ludovic,

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hello,
>
> Maxim Cournoyer <maxim.cournoyer <at> gmail.com> writes:
>
>> * 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
>
> I had a quick look and this looks great to me.

Thanks for the review!

> Minor issues:
>
>> +@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
>> +@{local-ca
>
> There’s a bug here: the line is truncated and markup is bogus.

Good catch!  Fixed like so:

--8<---------------cut here---------------start------------->8---
modified   doc/guix.texi
@@ -30905,7 +30905,8 @@ Messaging Services
 @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
-@{local-ca
+@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
modified   gnu/services/messaging.scm
@@ -1750,8 +1750,9 @@ (define-configuration pounce-configuration
   (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 @{local-ca}, a
-file name.  The file is reloaded when the SIGUSR1 signal is received.")
+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
--8<---------------cut here---------------end--------------->8---

> Also maybe “local-certificate-authorities”?
>
>> +@item @code{local-cert} (type: maybe-string)
>
> “local-certificate”?
>
>> +@item @code{local-priv} (type: maybe-string)
>
> “local-private-key”
>
>> +@item @code{client-cert} (type: maybe-string)
>
> [...]
>
>> +@item @code{client-priv} (type: maybe-string)
>
> Likewise.

All of the option names used match 1:1 what goes in the serialized
configuration file, and thus what is documented in 'man pounce'; so I've
chosen to keep the current names, for consistency.

Pushed as commit aab89b3d934.

-- 
Thanks,
Maxim

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.