@@ -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
@@ -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.
@@ -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.