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
This commit is contained in:
Vincent Ambo 2020-02-24 16:35:10 +00:00
parent 6380c168c9
commit 190378ad05

View file

@ -46,6 +46,7 @@
(require 'cl-lib) (require 'cl-lib)
(require 'ring) (require 'ring)
(require 'time-date) (require 'time-date)
(require 'subr-x)
(defgroup rcirc nil (defgroup rcirc nil
"Simple IRC client." "Simple IRC client."
@ -457,6 +458,8 @@ will be killed."
(defvar rcirc-user-name-history nil (defvar rcirc-user-name-history nil
"History variable for \\[rcirc] call.") "History variable for \\[rcirc] call.")
(defvar rcirc-last-message-time nil)
;;;###autoload ;;;###autoload
(defun rcirc (arg) (defun rcirc (arg)
"Connect to all servers in `rcirc-server-alist'. "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)) (unless (zerop (length password))
(rcirc-send-string process (concat "PASS " password))) (rcirc-send-string process (concat "PASS " password)))
(rcirc-send-string process (concat "NICK " nick)) (rcirc-send-string process (concat "NICK " nick))
(rcirc-send-string process "CAP LS 302")
(rcirc-send-string process (concat "USER " user-name (rcirc-send-string process (concat "USER " user-name
" 0 * :" full-name)) " 0 * :" full-name))
@ -783,7 +787,28 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(format "\"%s\" %s" text err) t))) (format "\"%s\" %s" text err) t)))
(rcirc-process-server-response-1 process text))) (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) (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) (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text)
(let* ((user (match-string 2 text)) (let* ((user (match-string 2 text))
(sender (rcirc-user-nick user)) (sender (rcirc-user-nick user))
@ -2459,7 +2484,10 @@ If ARG is given, opens the URL in a new browser window."
(defun rcirc-markup-timestamp (_sender _response) (defun rcirc-markup-timestamp (_sender _response)
(goto-char (point-min)) (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))) 'rcirc-timestamp)))
(defun rcirc-markup-attributes (_sender _response) (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) (defun rcirc-handler-CTCP-response (process _target sender message)
(rcirc-print process sender "CTCP" nil message t)) (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 (defgroup rcirc-faces nil
"Faces for rcirc." "Faces for rcirc."
:group 'rcirc :group 'rcirc