(defalias 'irc 'rcirc)
\f
- (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
(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)
(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))
\f
(defgroup rcirc-faces nil
projects / emacs.git / commitdiff