;;; Debugging the protocol
+(defvar erc-debug-irc-protocol-time-format "%FT%T.%6N%z "
+ "Timestamp format string for protocol logger.")
+
+(defconst erc-debug-irc-protocol-version "1"
+ "Protocol log format version number.
+This exists to help tooling track changes to the format.
+
+In version 1, everything before and including the first double CRLF is
+front matter, which must also be CRLF terminated. Lines beginning with
+three asterisks must be ignored as comments. Other lines should be
+interpreted as email-style headers. Folding is not supported. A second
+double CRLF, if present, signals the end of a log. Session resumption
+is not supported. Logger lines must adhere to the following format:
+TIMESTAMP PEER-NAME FLOW-INDICATOR IRC-MESSAGE CRLF. Outgoing messages
+are indicated with a >> and incoming with a <<.")
+
(defvar erc-debug-irc-protocol nil
"If non-nil, log all IRC protocol traffic to the buffer \"*erc-protocol*\".
The buffer is created if it doesn't exist.
-If OUTBOUND is non-nil, STRING is being sent to the IRC server
-and appears in face `erc-input-face' in the buffer."
+If OUTBOUND is non-nil, STRING is being sent to the IRC server and
+appears in face `erc-input-face' in the buffer. Lines must already
+contain CRLF endings. Peer is identified by the most precise label
+available at run time, starting with the network name, followed by the
+announced host name, and falling back to the dialed <server>:<port>."
(when erc-debug-irc-protocol
- (let ((network-name (or (ignore-errors (erc-network-name))
- "???")))
+ (let ((esid (or (and (fboundp 'erc-network)
+ (erc-network)
+ (erc-network-name))
+ erc-server-announced-name
+ (format "%s:%s" erc-session-server erc-session-port)))
+ (ts (when erc-debug-irc-protocol-time-format
+ (format-time-string erc-debug-irc-protocol-time-format))))
(with-current-buffer (get-buffer-create "*erc-protocol*")
(save-excursion
(goto-char (point-max))
(let ((inhibit-read-only t))
- (insert (if (not outbound)
- ;; Cope with the fact that string might
- ;; contain multiple lines of text.
- (let ((lines (delete "" (split-string string
- "\n\\|\r\n")))
- (result ""))
- (dolist (line lines)
- (setq result (concat result network-name
- " << " line "\n")))
- result)
- (propertize
- (concat network-name " >> " string
- (if (/= ?\n
- (aref string
- (1- (length string))))
- "\n"))
- 'font-lock-face 'erc-input-face)))))
+ (insert (if outbound
+ (concat ts esid " >> " string)
+ ;; Cope with multi-line messages
+ (let ((lines (split-string string "[\r\n]+" t))
+ result)
+ (dolist (line lines)
+ (setq result (concat result ts esid
+ " << " line "\r\n")))
+ result)))))
(let ((orig-win (selected-window))
(debug-buffer-window (get-buffer-window (current-buffer) t)))
(when debug-buffer-window
(with-current-buffer buf
(view-mode-enter)
(when (null (current-local-map))
- (let ((inhibit-read-only t))
- (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
- (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n")))
+ (let ((inhibit-read-only t)
+ (msg (list
+ (concat "Version: " erc-debug-irc-protocol-version)
+ (concat "Emacs-Version: " emacs-version)
+ (erc-make-notice
+ (concat "This buffer displays all IRC protocol "
+ "traffic exchanged with servers."))
+ (erc-make-notice "Kill it to disable logging.")
+ (erc-make-notice "Press `t' to toggle."))))
+ (insert (string-join msg "\r\n")))
(use-local-map (make-sparse-keymap))
(local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
(add-hook 'kill-buffer-hook
nil 'local)
(goto-char (point-max))
(let ((inhibit-read-only t))
- (insert (erc-make-notice
- (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n"
+ (insert (if erc-debug-irc-protocol "\r\n" "")
+ (erc-make-notice
+ (format "IRC protocol logging %s at %s"
(if erc-debug-irc-protocol "disabled" "enabled")
- (current-time-string))))))
+ (current-time-string)))
+ (if erc-debug-irc-protocol "\r\n" "\r\n\r\n"))))
(setq erc-debug-irc-protocol (not erc-debug-irc-protocol))
(if (and arg
(not (get-buffer-window "*erc-protocol*" t)))
(should (looking-at "abc")))))
(when noninteractive
(kill-buffer "*#fake*")))
+
+(ert-deftest erc-log-irc-protocol ()
+ (should-not erc-debug-irc-protocol)
+ (with-temp-buffer
+ (setq erc-server-process (start-process "fake" (current-buffer) "true")
+ erc-server-current-nick "tester"
+ erc-session-server "myproxy.localhost"
+ erc-session-port 6667)
+ (let ((inhibit-message noninteractive))
+ (erc-toggle-debug-irc-protocol)
+ (erc-log-irc-protocol "PASS changeme\r\n" 'outgoing)
+ (setq erc-server-announced-name "irc.gnu.org")
+ (erc-log-irc-protocol ":irc.gnu.org 001 tester :Welcome")
+ (erc-log-irc-protocol ":irc.gnu.org 002 tester :Your host is irc.gnu.org")
+ (setq erc-network 'FooNet)
+ (erc-log-irc-protocol ":irc.gnu.org 422 tester :MOTD missing")
+ (setq erc-network 'BarNet)
+ (erc-log-irc-protocol ":irc.gnu.org 221 tester +i")
+ (set-process-query-on-exit-flag erc-server-process nil)))
+ (with-current-buffer "*erc-protocol*"
+ (goto-char (point-min))
+ (search-forward "Version")
+ (search-forward "\r\n\r\n")
+ (search-forward "myproxy.localhost:6667 >> PASS" (line-end-position))
+ (forward-line)
+ (search-forward "irc.gnu.org << :irc.gnu.org 001" (line-end-position))
+ (forward-line)
+ (search-forward "irc.gnu.org << :irc.gnu.org 002" (line-end-position))
+ (forward-line)
+ (search-forward "FooNet << :irc.gnu.org 422" (line-end-position))
+ (forward-line)
+ (search-forward "BarNet << :irc.gnu.org 221" (line-end-position)))
+ (when noninteractive
+ (kill-buffer "*erc-protocol*")
+ (should-not erc-debug-irc-protocol)))