From 190378ad0512a218fe52b3dad1911b561f5a1506 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Mon, 24 Feb 2020 16:35:10 +0000 Subject: feat(3p/emacs/rcirc): Implement support for IRCv3 server-time This adds very basic capability[0] and message tag[1] support to rcirc which is used to implement support for the IRCv3 server-time[2] spec. During connection setup, the server is asked to list its capabilities and the `server-time` capability is then blindly requested from it (the CAP handler code does not check whether server-time is actually part of the listed capabilities). rcirc does not need to know whether this negotiation succeeded, because server time tags will either be sent or not. By default rcirc prints all timestamps at current-time. A new variable `rcirc-last-message-time` has been added which, if set, overrides this timestamp. It is set by the message handler after parsing IRCv3 tags. Thanks to William Cummings for nudging me in the direction of his post about adding ZNC playback support to rcirc[4], from which some parts of this code were taken. This has been tested with IRCCloud's bouncers. [0]: https://ircv3.net/specs/core/capability-negotiation [1]: https://ircv3.net/specs/extensions/message-tags [2]: https://ircv3.net/specs/extensions/server-time-3.2.html --- third_party/emacs/rcirc/rcirc.el | 53 ++++++++++++++++++++++++++++++++++------ 1 file changed, 46 insertions(+), 7 deletions(-) (limited to 'third_party/emacs/rcirc') diff --git a/third_party/emacs/rcirc/rcirc.el b/third_party/emacs/rcirc/rcirc.el index de524d9ef108..b59cb4e9afe4 100644 --- a/third_party/emacs/rcirc/rcirc.el +++ b/third_party/emacs/rcirc/rcirc.el @@ -46,6 +46,7 @@ (require 'cl-lib) (require 'ring) (require 'time-date) +(require 'subr-x) (defgroup rcirc nil "Simple IRC client." @@ -457,6 +458,8 @@ will be killed." (defvar rcirc-user-name-history nil "History variable for \\[rcirc] call.") +(defvar rcirc-last-message-time nil) + ;;;###autoload (defun rcirc (arg) "Connect to all servers in `rcirc-server-alist'. @@ -609,6 +612,7 @@ If ARG is non-nil, instead prompt for connection parameters." (unless (zerop (length password)) (rcirc-send-string process (concat "PASS " password))) (rcirc-send-string process (concat "NICK " nick)) + (rcirc-send-string process "CAP LS 302") (rcirc-send-string process (concat "USER " user-name " 0 * :" full-name)) @@ -783,7 +787,28 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (format "\"%s\" %s" text err) t))) (rcirc-process-server-response-1 process text))) +(defun rcirc-handle-message-tags (tags) + (if-let* ((time (cdr (assoc "time" tags))) + (timestamp (floor (float-time (date-to-time time))))) + (setq rcirc-last-message-time timestamp))) + +(defun rcirc-parse-tags (tags) + "Parse TAGS message prefix." + (mapcar (lambda (tag) + (let ((p (split-string tag "="))) + `(,(car p) . ,(cadr p)))) + (split-string tags ";"))) + (defun rcirc-process-server-response-1 (process text) + + ;; attempt to extract and handle IRCv3 message tags (which contain server-time) + (if (string-match "^\\(@\\([^ ]+\\) \\)?\\(\\(:[^ ]+ \\)?[^ ]+ .+\\)$" text) + (let ((tags (match-string 2 text)) + (rest (match-string 3 text))) + (when tags + (rcirc-handle-message-tags (rcirc-parse-tags tags))) + (setq text rest))) + (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text) (let* ((user (match-string 2 text)) (sender (rcirc-user-nick user)) @@ -795,11 +820,11 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (args2 (match-string 2 args)) (args (delq nil (append (split-string args1 " " t) (list args2))))) - (if (not (fboundp handler)) - (rcirc-handler-generic process cmd sender args text) - (funcall handler process sender args text)) - (run-hook-with-args 'rcirc-receive-message-functions - process cmd sender args text))) + (if (not (fboundp handler)) + (rcirc-handler-generic process cmd sender args text) + (funcall handler process sender args text)) + (run-hook-with-args 'rcirc-receive-message-functions + process cmd sender args text))) (message "UNHANDLED: %s" text))) (defvar rcirc-responses-no-activity '("305" "306") @@ -2459,7 +2484,10 @@ If ARG is given, opens the URL in a new browser window." (defun rcirc-markup-timestamp (_sender _response) (goto-char (point-min)) - (insert (rcirc-facify (format-time-string rcirc-time-format) + (insert (rcirc-facify (format-time-string rcirc-time-format + (let ((time rcirc-last-message-time)) + (when time (setq rcirc-last-message-time nil)) + time)) 'rcirc-timestamp))) (defun rcirc-markup-attributes (_sender _response) @@ -2956,7 +2984,18 @@ Passwords are stored in `rcirc-authinfo' (which see)." (defun rcirc-handler-CTCP-response (process _target sender message) (rcirc-print process sender "CTCP" nil message t)) - + +(defun rcirc-handler-CAP (process _sender args _text) + (when (equal (cadr args) "LS") + (rcirc-send-string process "CAP REQ :server-time")) + + (when (or (equal (cadr args) "ACK") + (equal (cadr args) "NAK")) + ;; Capability negotiation is best-effort here, I know that my + ;; servers support server-time and thus we end negotiation + ;; immediately. + (rcirc-send-string process "CAP END"))) + (defgroup rcirc-faces nil "Faces for rcirc." :group 'rcirc -- cgit 1.4.1