feature/rcirc-update 6122e4c 3/3: Add SASL authentication to rcirc

[Philip Kaludercic]

branch: feature/rcirc-update
commit 6122e4c1f07a59196832f95a64a45517e7c5cce8
Author: Alex McGrath <amk@amk.ie>
Commit: Philip Kaludercic <philipk@posteo.net>

    Add SASL authentication to rcirc
    
    * lisp/net/rcirc.el (rcirc-handler-AUTHENTICATE): New function
    (bug#48601).
    (rcirc-authenticate):
    (rcirc-connect): Support sasl.
    (rcirc-get-server-password, rcirc-get-server-method): New functions.
    (rcirc-authinfo): Document it.
---
 doc/misc/rcirc.texi |  6 ++++++
 lisp/net/rcirc.el   | 42 ++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index ff8133b..e187bbb 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -590,6 +590,12 @@ Use this symbol if you need to identify yourself in the 
Bitlbee channel
 as follows: @code{identify secret}.  The necessary arguments are the
 nickname you want to use this for, and the password to use.
 
+@item sasl
+@cindex sasl authentication
+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.
+
 @cindex gateway to other IM services
 @cindex instant messaging, other services
 @cindex Jabber
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 6c27acf..37c31be 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -261,13 +261,15 @@ The ARGUMENTS for each METHOD symbol are:
   `chanserv': NICK CHANNEL PASSWORD
   `bitlbee': NICK PASSWORD
   `quakenet': ACCOUNT PASSWORD
+  `sasl': NICK PASSWORD
 
 Examples:
  ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
   (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
   (\"bitlbee\" bitlbee \"robert\" \"sekrit\")
   (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
-  (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
+  (\"quakenet.org\" quakenet \"bobby\" \"sekrit\")
+  (\"oftc\" sasl \"bob\" \"hunter2\"))"
   :type '(alist :key-type (regexp :tag "Server")
                :value-type (choice (list :tag "NickServ"
                                          (const nickserv)
@@ -285,6 +287,10 @@ Examples:
                                     (list :tag "QuakeNet"
                                           (const quakenet)
                                           (string :tag "Account")
+                                          (string :tag "Password"))
+                                    (list :tag "SASL"
+                                          (const sasl)
+                                          (string :tag "Nick")
                                           (string :tag "Password")))))
 
 (defcustom rcirc-auto-authenticate-flag t
@@ -597,6 +603,7 @@ See `rcirc-connect' for more details on these variables.")
     "batch"                             
;https://ircv3.net/specs/extensions/batch
     "message-ids"                       
;https://ircv3.net/specs/extensions/message-ids
     "invite-notify"                     
;https://ircv3.net/specs/extensions/invite-notify
+    "sasl"                              
;https://ircv3.net/specs/extensions/sasl-3.1
     )
   "A list of capabilities that rcirc supports.")
 (defvar-local rcirc-requested-capabilities nil
@@ -604,6 +611,24 @@ See `rcirc-connect' for more details on these variables.")
 (defvar-local rcirc-acked-capabilities nil
   "A list of capabilities that the server supports.")
 
+(defun rcirc-get-server-method (server)
+  "Return authentication method for SERVER."
+  (catch 'method
+    (dolist (i rcirc-authinfo)
+      (let ((server-i (car i))
+           (method (cadr i)))
+       (when (string-match server-i server)
+          (throw 'method method))))))
+
+(defun rcirc-get-server-password (server)
+  "Return password for SERVER."
+  (catch 'pass
+    (dolist (i rcirc-authinfo)
+      (let ((server-i (car i))
+           (args (cdddr i)))
+       (when (string-match server-i server)
+          (throw 'pass (car args)))))))
+
 ;;;###autoload
 (defun rcirc-connect (server &optional port nick user-name
                              full-name startup-channels password encryption
@@ -3317,7 +3342,8 @@ Passwords are stored in `rcirc-authinfo' (which see)."
                  (rcirc-send-privmsg
                   process
                   "&bitlbee"
-                  (concat "IDENTIFY " (car args)))))
+                  (concat "IDENTIFY " (car args))))
+                (sasl nil))
             ;; quakenet authentication doesn't rely on the user's nickname.
             ;; the variable `nick' here represents the Q account name.
             (when (eq method 'quakenet)
@@ -3394,6 +3420,7 @@ PROCESS is the process object for the current connection."
 PROCESS is the process object for the current connection."
   (rcirc-print process sender "CTCP" nil message t))
 
+
 (defun rcirc-handler-CAP (process _sender args _text)
   "Handle capability negotiation messages.
 ARGS should have the form (USER SUBCOMMAND . ARGUMENTS).  PROCESS
@@ -3464,6 +3491,17 @@ object for the current connection."
               (delq (assoc id rcirc-batched-messages)
                     rcirc-batched-messages)))))))
 
+(defun rcirc-handler-AUTHENTICATE (process _cmd _args _text)
+  "Respond to authentication request.
+PROCESS is the process object for the current connection."
+  (rcirc-send-string
+   process
+   "AUTHENTICATE"
+   (base64-encode-string
+    ;; use connection user-name
+    (concat "\0" (nth 3 rcirc-connection-info)
+            "\0" (rcirc-get-server-password rcirc-server)))))
+
 
 (defgroup rcirc-faces nil
   "Faces for rcirc."