From: Philip Kaludercic Date: Fri, 23 Jul 2021 11:23:35 +0000 (+0200) Subject: Merge branch 'feature/rcirc-update' X-Git-Tag: emacs-28.0.90~1748 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=55a19a1da26d35673c8eb2c52171ff3b31594dd9;p=emacs.git Merge branch 'feature/rcirc-update' --- 55a19a1da26d35673c8eb2c52171ff3b31594dd9 diff --cc lisp/net/rcirc.el index 6c660d25e1c,af0def8e474..79653728e5c --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@@ -536,35 -568,69 +568,85 @@@ If ARG is non-nil, instead prompt for c (defalias 'irc 'rcirc) - (defvar rcirc-process-output nil) - (defvar rcirc-topic nil) - (defvar rcirc-keepalive-timer nil) - (defvar rcirc-last-server-message-time nil) - (defvar rcirc-server nil) ; server provided by server - (defvar rcirc-server-name nil) ; server name given by 001 response - (defvar rcirc-timeout-timer nil) - (defvar rcirc-user-authenticated nil) - (defvar rcirc-user-disconnect nil) - (defvar rcirc-connecting nil) - (defvar rcirc-connection-info nil) - (defvar rcirc-process nil) + (defvar-local rcirc-process-output nil + "Partial message response.") + (defvar-local rcirc-topic nil + "Topic of the current channel.") + (defvar rcirc-keepalive-timer nil + "Timer for sending KEEPALIVE message.") + (defvar-local rcirc-last-server-message-time nil + "Timestamp for the last server response.") + (defvar-local rcirc-server nil + "Server provided by server.") + (defvar-local rcirc-server-name nil + "Server name given by 001 response.") + (defvar-local rcirc-timeout-timer nil + "Timer for determining a network timeout.") + (defvar-local rcirc-user-authenticated nil + "Flag indicating if the user is authenticated.") + (defvar-local rcirc-user-disconnect nil + "Flag indicating if the connection was broken.") + (defvar-local rcirc-connecting nil + "Flag indicating if the connection is being established.") + (defvar-local rcirc-connection-info nil + "Information about the current connection. + If defined, it is a list of this form (SERVER PORT NICK USER-NAME + FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS). + See `rcirc-connect' for more details on these variables.") + (defvar-local rcirc-process nil + "Network process for the current connection.") + + ;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation) + (defvar rcirc-implemented-capabilities + '("message-tags" ;https://ircv3.net/specs/extensions/message-tags + "server-time" ;https://ircv3.net/specs/extensions/server-time + "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 + "A list of capabilities that client has requested.") + (defvar-local rcirc-acked-capabilities nil + "A list of capabilities that the server supports.") + (defvar-local rcirc-finished-sasl t + "Check whether SASL authentication has completed") + + (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))))))) +(defun rcirc-get-server-method (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) + (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 @@@ -593,36 -665,31 +681,33 @@@ that are joined after authentication. (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) - (setq-local rcirc-connection-info - (list server port nick user-name full-name startup-channels - password encryption server-alias)) - (setq-local rcirc-process process) - (setq-local rcirc-server server) - (setq-local rcirc-server-name - (or server-alias server)) ; Update when we get 001 response. - (setq-local rcirc-buffer-alist nil) - (setq-local rcirc-nick-table (make-hash-table :test 'equal)) - (setq-local rcirc-nick nick) - (setq-local rcirc-process-output nil) - (setq-local rcirc-startup-channels startup-channels) - (setq-local rcirc-last-server-message-time (current-time)) - - (setq-local rcirc-timeout-timer nil) - (setq-local rcirc-user-disconnect nil) - (setq-local rcirc-user-authenticated nil) - (setq-local rcirc-connecting t) - (setq-local rcirc-server-parameters nil) + (setq rcirc-connection-info + (list server port nick user-name full-name startup-channels + password encryption server-alias)) + (setq rcirc-process process) + (setq rcirc-server server) + (setq rcirc-server-name (or server-alias server)) ; Update when we get 001 response. + (setq rcirc-nick-table (make-hash-table :test 'equal)) + (setq rcirc-nick nick) + (setq rcirc-startup-channels startup-channels) + (setq rcirc-last-server-message-time (current-time)) + + (setq rcirc-connecting t) (add-hook 'auto-save-hook 'rcirc-log-write) + (when use-sasl + (rcirc-send-string process "CAP REQ sasl")) + (when use-sasl + (setq-local rcirc-finished-sasl nil)) ;; identify + (dolist (cap rcirc-implemented-capabilities) + (rcirc-send-string process "CAP" "REQ" : cap) + (push cap rcirc-requested-capabilities)) (unless (zerop (length password)) - (rcirc-send-string process (concat "PASS " password))) - (rcirc-send-string process (concat "NICK " nick)) - (rcirc-send-string process (concat "USER " user-name - " 0 * :" full-name)) + (rcirc-send-string process "PASS" password)) + (rcirc-send-string process "NICK" nick) + (rcirc-send-string process "USER" user-name "0" "*" : full-name) ;; Setup sasl, and initiate authentication. (when (and rcirc-auto-authenticate-flag use-sasl) @@@ -2983,31 -3418,117 +3436,117 @@@ current connection. (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) - (defun rcirc-handler-ctcp-VERSION (process _target sender _args) - (rcirc-send-string process - (concat "NOTICE " sender - " :\C-aVERSION " rcirc-id-string - "\C-a"))) + (defun rcirc-handler-ctcp-VERSION (process _target sender _message) + "Handle a CTCP VERSION message from SENDER. + PROCESS is the process object for the current connection." + (rcirc-send-string process "NOTICE" sender : + (rcirc-ctcp-wrap "VERSION" rcirc-id-string))) - (defun rcirc-handler-ctcp-ACTION (process target sender args) - (rcirc-print process sender "ACTION" target args t)) + (defun rcirc-handler-ctcp-ACTION (process target sender message) + "Handle a CTCP ACTION MESSAGE from SENDER to TARGET. + PROCESS is the process object for the current connection." + (rcirc-print process sender "ACTION" target message t)) - (defun rcirc-handler-ctcp-TIME (process _target sender _args) - (rcirc-send-string process - (concat "NOTICE " sender - " :\C-aTIME " (current-time-string) "\C-a"))) + (defun rcirc-handler-ctcp-TIME (process _target sender _message) + "Respond to CTCP TIME message from SENDER. + PROCESS is the process object for the current connection." + (rcirc-send-string process "NOTICE" sender : + (rcirc-ctcp-wrap "TIME" (current-time-string)))) (defun rcirc-handler-CTCP-response (process _target sender message) + "Handle CTCP response MESSAGE from SENDER. + 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 + is the process object for the current connection." + (with-rcirc-process-buffer process + (let ((subcmd (cadr args))) + (dolist (cap (cddr args)) + (cond ((string= subcmd "ACK") + (push cap rcirc-acked-capabilities) + (setq rcirc-requested-capabilities + (delete cap rcirc-requested-capabilities))) + ((string= subcmd "NAK") + (setq rcirc-requested-capabilities + (delete cap rcirc-requested-capabilities)))))) + (when (and (null rcirc-requested-capabilities) rcirc-finished-sasl) + ;; All requested capabilities have been responded to + (rcirc-send-string process "CAP" "END")))) + + (defun rcirc-handler-TAGMSG (process sender _args _text) + "Handle a empty tag message from SENDER. + PROCESS is the process object for the current connection." + (dolist (tag rcirc-message-tags) + (when-let ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag)))) + ((fboundp handler))) + (funcall handler process sender (cdr tag))))) + + (defun rcirc-handler-BATCH (process _sender args _text) + "Open or close a batch. + ARGS should have the form (tag type . parameters) when starting a + batch, or (tag) when closing a batch. PROCESS is the process + object for the current connection." + (with-rcirc-process-buffer process + (let ((type (cadr args)) + (id (substring (car args) 1))) + (cond + ((= (aref (car args) 0) ?+) ;start a new batch + (when (assoc id rcirc-batch-attributes) + (error "Starting batch with already used ID")) + (setf (alist-get id rcirc-batch-attributes nil nil #'string=) + (cons type (cddr args)))) + ((= (aref (car args) 0) ?-) ;close a batch + (unless (assoc id rcirc-batch-attributes) + (error "Closing a unknown batch")) + (let ((type (car (alist-get id rcirc-batch-attributes + nil nil #'string=)))) + (when (eq (car (alist-get type rcirc-supported-batch-types + nil nil #'string=)) + 'deferred) + (let ((messages (alist-get id rcirc-batched-messages + nil nil #'string=)) + (bhandler (intern-soft (concat "rcirc-batch-handler-" type)))) + (if (fboundp bhandler) + (funcall bhandler process id (nreverse messages)) + (dolist (message (nreverse messages)) + (let ((cmd (nth 0 message)) + (process (nth 1 message)) + (sender (nth 2 message)) + (args (nth 3 message)) + (text (nth 4 message)) + (rcirc-message-tags (nth 5 message))) + (if-let (handler (intern-soft (concat "rcirc-handler-" cmd))) + (funcall handler process sender args text) + (rcirc-handler-generic process cmd sender args text)))))))) + (setq rcirc-batch-attributes + (delq (assoc id rcirc-batch-attributes) + rcirc-batch-attributes) + rcirc-batched-messages + (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 - (format "AUTHENTICATE %s" - (base64-encode-string - ;; use connection user-name - (concat "\0" (nth 3 rcirc-connection-info) - "\0" (rcirc-get-server-password rcirc-server)))))) + "AUTHENTICATE" + (base64-encode-string + ;; use connection user-name + (concat "\0" (nth 3 rcirc-connection-info) + "\0" (rcirc-get-server-password rcirc-server))))) + + (defun rcirc-handler-900 (process sender args _text) - "Respond to a successful authentication response" ++ "Respond to a successful authentication response." + (rcirc-handler-generic process "900" sender args nil) + (when (not rcirc-finished-sasl) + (setq-local rcirc-finished-sasl t) + (rcirc-send-string process "CAP" "END")) + (rcirc-join-channels-post-auth process)) (defgroup rcirc-faces nil