From b79cb838a477ee5a5c3660e81264991ff833a82f Mon Sep 17 00:00:00 2001
From: Omar Polo <op@omarpolo.com>
Date: Mon, 15 Nov 2021 17:40:58 +0000
Subject: [PATCH] implement certfp authentication to rcirc

* lisp/net/rcirc.el (rcirc-connect): Use the provided client certs
* doc/misc/rcirc.texi (Configuration): Document the change
---
 doc/misc/rcirc.texi |  7 +++++++
 lisp/net/rcirc.el   | 26 ++++++++++++++++++++++----
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index 696983dc771..58ca045e786 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -633,6 +633,13 @@ Use this symbol if you want to use @acronym{SASL} authentication.  The
 necessary arguments are the nickname you want to use this for, and the
 password to use.
 
+@item certfp
+@cindex certfp authentication
+Use this symbol if you want to use CertFP authentication.  The
+necessary arguments are the path to the client certificate key and
+password.  The CertFP authentication requires a @acronym{TLS}
+connection.
+
 @end table
 
 @end table
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 5c92c60eda2..6030db9daeb 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -262,6 +262,7 @@ The ARGUMENTS for each METHOD symbol are:
   `bitlbee': NICK PASSWORD
   `quakenet': ACCOUNT PASSWORD
   `sasl': NICK PASSWORD
+  `certfp': KEY CERT
 
 Examples:
  ((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\")
@@ -291,7 +292,11 @@ Examples:
                                     (list :tag "SASL"
                                           (const sasl)
                                           (string :tag "Nick")
-                                          (string :tag "Password")))))
+                                          (string :tag "Password"))
+                                    (list :tag "CertFP"
+                                          (const certfp)
+                                          (string :tag "Key")
+                                          (string :tag "Certificate")))))
 
 (defcustom rcirc-auto-authenticate-flag t
   "Non-nil means automatically send authentication string to server.
@@ -547,6 +552,9 @@ If ARG is non-nil, instead prompt for connection parameters."
               (password (plist-get (cdr c) :password))
               (encryption (plist-get (cdr c) :encryption))
               (server-alias (plist-get (cdr c) :server-alias))
+              (client-cert (when (eq (rcirc-get-server-method (car c))
+                                     'certfp)
+                             (rcirc-get-server-cert (car c))))
               contact)
           (when-let (((not password))
                      (auth (auth-source-search :host server
@@ -563,7 +571,7 @@ If ARG is non-nil, instead prompt for connection parameters."
 		  (condition-case nil
 		      (let ((process (rcirc-connect server port nick user-name
                                                     full-name channels password encryption
-                                                    server-alias)))
+                                                    client-cert server-alias)))
                         (when rcirc-display-server-buffer
                           (pop-to-buffer-same-window (process-buffer process))))
 		    (quit (message "Quit connecting to %s"
@@ -662,13 +670,22 @@ See `rcirc-connect' for more details on these variables.")
 	(when (string-match server-i server)
           (throw 'pass (car args)))))))
 
+(defun rcirc-get-server-cert (server)
+  "Return a list of key and certificate for SERVER."
+  (catch 'cert
+    (dolist (i rcirc-authinfo)
+      (let ((server-i (car i))
+            (args (cddr i)))
+        (when (string-match server-i server)
+          (throw 'cert args))))))
+
 ;;;###autoload
 (defun rcirc-connect (server &optional port nick user-name
                              full-name startup-channels password encryption
-                             server-alias)
+                             certfp server-alias)
   "Connect to SERVER.
 The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
-ENCRYPTION, SERVER-ALIAS are interpreted as in
+ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in
 `rcirc-server-alist'.  STARTUP-CHANNELS is a list of channels
 that are joined after authentication."
   (save-excursion
@@ -695,6 +712,7 @@ that are joined after authentication."
       (setq process (open-network-stream
                      (or server-alias server) nil server port-number
                      :type (or encryption 'plain)
+                     :client-certificate certfp
                      :nowait t))
       (set-process-coding-system process 'raw-text 'raw-text)
       (with-current-buffer (get-buffer-create (rcirc-generate-new-buffer-name process nil))
-- 
2.39.2