diff options
Diffstat (limited to 'lisp/net/rcirc.el')
| -rw-r--r-- | lisp/net/rcirc.el | 213 |
1 files changed, 126 insertions, 87 deletions
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index b23b0d64ae6..54d7861f445 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -130,7 +130,7 @@ be displayed instead." (defcustom rcirc-default-port 6667 "The default port to connect to." - :type 'integer) + :type 'natnum) (defcustom rcirc-default-nick (user-login-name) "Your nick." @@ -262,10 +262,12 @@ The ARGUMENTS for each METHOD symbol are: `bitlbee': NICK PASSWORD `quakenet': ACCOUNT PASSWORD `sasl': NICK PASSWORD + `certfp': KEY CERT Examples: ((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\") (\"Libera.Chat\" chanserv \"bob\" \"#bobland\" \"passwd99\") + (\"Libera.Chat\" certfp \"/path/to/key\" \"/path/to/cert\") (\"bitlbee\" bitlbee \"robert\" \"sekrit\") (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\") (\"quakenet.org\" quakenet \"bobby\" \"sekrit\") @@ -291,7 +293,11 @@ Examples: (list :tag "SASL" (const sasl) (string :tag "Nick") - (string :tag "Password"))))) + (string :tag "Password")) + (list :tag "CertFP" + (const certfp) + (string :tag "Key") + (string :tag "Certificate"))))) (defcustom rcirc-auto-authenticate-flag t "Non-nil means automatically send authentication string to server. @@ -428,6 +434,20 @@ will be killed." :version "28.1" :type 'boolean) +(defcustom rcirc-cycle-completion-flag nil + "Non-nil means to use cycling for completion in rcirc buffers. +See the Info node `(emacs) Completion Options' for background on +what cycling completion means." + :version "29.1" + :set (lambda (sym val) + (dolist (buf (match-buffers '(major-mode . rcirc-mode))) + (with-current-buffer buf + (if val + (setq-local completion-cycle-threshold t) + (kill-local-variable 'completion-cycle-threshold)))) + (set-default sym val)) + :type 'boolean) + (defvar-local rcirc-nick nil "The nickname used for the current connection.") @@ -547,13 +567,16 @@ If ARG is non-nil, instead prompt for connection parameters." (password (plist-get (cdr c) :password)) (encryption (plist-get (cdr c) :encryption)) (server-alias (plist-get (cdr c) :server-alias)) + (client-cert (when (eq (rcirc-get-server-method (car c)) + 'certfp) + (rcirc-get-server-cert (car c)))) contact) (when-let (((not password)) (auth (auth-source-search :host server :user user-name :port port)) - (fn (plist-get (car auth) :secret))) - (setq password (funcall fn))) + (pwd (auth-info-password (car auth)))) + (setq password pwd)) (when server (let (connected) (dolist (p (rcirc-process-list)) @@ -563,7 +586,7 @@ If ARG is non-nil, instead prompt for connection parameters." (condition-case nil (let ((process (rcirc-connect server port nick user-name full-name channels password encryption - server-alias))) + client-cert server-alias))) (when rcirc-display-server-buffer (pop-to-buffer-same-window (process-buffer process)))) (quit (message "Quit connecting to %s" @@ -646,29 +669,23 @@ See `rcirc-connect' for more details on these variables.") (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)))))) + (cadr (assoc server rcirc-authinfo #'string-match))) (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))))))) + (cadddr (assoc server rcirc-authinfo #'string-match))) + +(defun rcirc-get-server-cert (server) + "Return a list of key and certificate for SERVER." + (cddr (assoc server rcirc-authinfo #'string-match))) ;;;###autoload (defun rcirc-connect (server &optional port nick user-name full-name startup-channels password encryption - server-alias) + certfp server-alias) "Connect to SERVER. The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD, -ENCRYPTION, SERVER-ALIAS are interpreted as in +ENCRYPTION, CERTFP, SERVER-ALIAS are interpreted as in `rcirc-server-alist'. STARTUP-CHANNELS is a list of channels that are joined after authentication." (save-excursion @@ -695,6 +712,7 @@ that are joined after authentication." (setq process (open-network-stream (or server-alias server) nil server port-number :type (or encryption 'plain) + :client-certificate certfp :nowait t)) (set-process-coding-system process 'raw-text 'raw-text) (with-current-buffer (get-buffer-create (rcirc-generate-new-buffer-name process nil)) @@ -713,8 +731,8 @@ that are joined after authentication." (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-last-connect-time (current-time)) + (setq rcirc-last-server-message-time rcirc-last-connect-time) ;; Check if the immediate process state (sit-for .1) @@ -754,18 +772,26 @@ SERVER-PLIST is the property list for the server." (yes-or-no-p "Encrypt connection?")) 'tls 'plain)) +(defvar rcirc-reconnect-delay) (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. Kill processes that have not received a server message since the last ping." (if (rcirc-process-list) (mapc (lambda (process) - (with-rcirc-process-buffer process - (when (not rcirc-connecting) - (rcirc-send-ctcp process - rcirc-nick - (format "KEEPALIVE %f" - (float-time)))))) + (with-rcirc-process-buffer process + (when (not rcirc-connecting) + (condition-case nil + (rcirc-send-ctcp process + rcirc-nick + (format "KEEPALIVE %f" + (float-time))) + (rcirc-closed-connection + (if (zerop rcirc-reconnect-delay) + (message "rcirc: Connection to %s closed" + (process-name process)) + (rcirc-reconnect process)) + (message "")))))) (rcirc-process-list)) ;; no processes, clean up timer (when (timerp rcirc-keepalive-timer) @@ -1057,17 +1083,18 @@ Note that the messages are stored in reverse order.") ;; expression and `rcirc-process-regexp'. (error "Malformed tag %S" tag)) (cons (match-string 1 tag) - (replace-regexp-in-string - (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n)) - (lambda (rep) - (concat (substring rep 0 -2) - (cl-case (aref rep (1- (length rep))) - (?: ";") - (?s " ") - (?\\ "\\\\") - (?r "\r") - (?n "\n")))) - (match-string 2 tag)))) + (when (match-string 2 tag) + (replace-regexp-in-string + (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n)) + (lambda (rep) + (concat (substring rep 0 -2) + (cl-case (aref rep (1- (length rep))) + (?: ";") + (?s " ") + (?\\ "\\\\") + (?r "\r") + (?n "\n")))) + (match-string 2 tag))))) (split-string tag-data ";")))) rcirc-message-tags)) (user (match-string 3 text)) @@ -1119,6 +1146,8 @@ used as the message body." "Check if PROCESS is open or running." (memq (process-status process) '(run open))) +(define-error 'rcirc-closed-connection "Network connection not open") + (defun rcirc-send-string (process &rest parts) "Send PROCESS a PARTS plus a newline. PARTS may contain a `:' symbol, to designate that the next string @@ -1136,8 +1165,7 @@ element in PARTS is a list, append it to PARTS." rcirc-encode-coding-system) "\n"))) (unless (rcirc--connection-open-p process) - (error "Network connection to %s is not open" - (process-name process))) + (signal 'rcirc-closed-connection process)) (rcirc-debug process string) (process-send-string process string))) @@ -1318,33 +1346,30 @@ The list is updated automatically by `defun-rcirc-command'.") 'set-rcirc-encode-coding-system "28.1") -(defvar rcirc-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'rcirc-send-input) - (define-key map (kbd "M-p") 'rcirc-insert-prev-input) - (define-key map (kbd "M-n") 'rcirc-insert-next-input) - (define-key map (kbd "TAB") 'completion-at-point) - (define-key map (kbd "C-c C-b") 'rcirc-browse-url) - (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline) - (define-key map (kbd "C-c C-j") 'rcirc-cmd-join) - (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick) - (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority) - (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode) - (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg) - (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename - (define-key map (kbd "C-c C-o") 'rcirc-omit-mode) - (define-key map (kbd "C-c C-p") 'rcirc-cmd-part) - (define-key map (kbd "C-c C-q") 'rcirc-cmd-query) - (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic) - (define-key map (kbd "C-c C-n") 'rcirc-cmd-names) - (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois) - (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit) - (define-key map (kbd "C-c TAB") ; C-i - 'rcirc-toggle-ignore-buffer-activity) - (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer) - (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line) - map) - "Keymap for rcirc mode.") +(defvar-keymap rcirc-mode-map + :doc "Keymap for rcirc mode." + "RET" #'rcirc-send-input + "M-p" #'rcirc-insert-prev-input + "M-n" #'rcirc-insert-next-input + "TAB" #'completion-at-point + "C-c C-b" #'rcirc-browse-url + "C-c C-c" #'rcirc-edit-multiline + "C-c C-j" #'rcirc-cmd-join + "C-c C-k" #'rcirc-cmd-kick + "C-c C-l" #'rcirc-toggle-low-priority + "C-c C-d" #'rcirc-cmd-mode + "C-c C-m" #'rcirc-cmd-msg + "C-c C-r" #'rcirc-cmd-nick ; rename + "C-c C-o" #'rcirc-omit-mode + "C-c C-p" #'rcirc-cmd-part + "C-c C-q" #'rcirc-cmd-query + "C-c C-t" #'rcirc-cmd-topic + "C-c C-n" #'rcirc-cmd-names + "C-c C-w" #'rcirc-cmd-whois + "C-c C-x" #'rcirc-cmd-quit + "C-c C-i" #'rcirc-toggle-ignore-buffer-activity + "C-c C-s" #'rcirc-switch-to-server-buffer + "C-c C-a" #'rcirc-jump-to-first-unread-line) (defvar-local rcirc-short-buffer-name nil "Generated abbreviation to use to indicate buffer activity.") @@ -1431,7 +1456,8 @@ PROCESS is the process object used for communication. (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) - (setq-local completion-cycle-threshold t) + (when rcirc-cycle-completion-flag + (setq-local completion-cycle-threshold t)) (run-mode-hooks 'rcirc-mode-hook)) @@ -1680,16 +1706,17 @@ extracted." (setq rcirc-parent-buffer parent) (insert text) (and (> pos 0) (goto-char pos)) - (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent)))) - -(defvar rcirc-multiline-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'rcirc-multiline-minor-submit) - (define-key map (kbd "C-x C-s") 'rcirc-multiline-minor-submit) - (define-key map (kbd "C-c C-k") 'rcirc-multiline-minor-cancel) - (define-key map (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel) - map) - "Keymap for multiline mode in rcirc.") + (message "Type %s to return text to %s, or %s to cancel" + (substitute-command-keys "\\[rcirc-multiline-minor-submit]") + parent + (substitute-command-keys "\\[rcirc-multiline-minor-cancel]"))))) + +(defvar-keymap rcirc-multiline-minor-mode-map + :doc "Keymap for multiline mode in rcirc." + "C-c C-c" #'rcirc-multiline-minor-submit + "C-x C-s" #'rcirc-multiline-minor-submit + "C-c C-k" #'rcirc-multiline-minor-cancel + "ESC ESC ESC" #'rcirc-multiline-minor-cancel) (define-minor-mode rcirc-multiline-minor-mode "Minor mode for editing multiple lines in rcirc." @@ -2044,6 +2071,13 @@ connection." (run-hook-with-args 'rcirc-print-functions process sender response target text))))) +(defun rcirc-when () + "Show the time of reception of the message at point." + (interactive) + (if-let (time (get-text-property (point) 'rcirc-time)) + (message (format-time-string "%c" time)) + (message "No time information at point."))) + (defun rcirc-generate-log-filename (process target) "Return filename for log file based on PROCESS and TARGET." (if target @@ -2230,12 +2264,10 @@ This function does not alter the INPUT string." (mapconcat rcirc-nick-filter sorted sep))) ;;; activity tracking -(defvar rcirc-track-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-@") 'rcirc-next-active-buffer) - (define-key map (kbd "C-c C-SPC") 'rcirc-next-active-buffer) - map) - "Keymap for rcirc track minor mode.") +(defvar-keymap rcirc-track-minor-mode-map + :doc "Keymap for rcirc track minor mode." + "C-c C-@" #'rcirc-next-active-buffer + "C-c C-SPC" #'rcirc-next-active-buffer) (defcustom rcirc-track-abbrevate-flag t "Non-nil means `rcirc-track-minor-mode' should abbreviate names." @@ -2582,15 +2614,22 @@ that, an interactive form can specified." (defun ,fn-name (,argument &optional process target) ,(concat documentation "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - (interactive (list ,interactive-spec)) + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + (interactive ,(if (stringp interactive-spec) + ;; HACK: Necessary to wrap the result of + ;; the interactive spec in a list. + `(list (call-interactively + (lambda (&rest args) + (interactive ,interactive-spec) + args))) + `(list ,interactive-spec))) (unless (if (listp ,argument) (<= ,required (length ,argument) ,total) (string-match ,regexp ,argument)) (user-error "Malformed input (%s): %S" ',command ,argument)) (push ,(upcase (symbol-name command)) rcirc-pending-requests) (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) + (target (or target rcirc-target))) (ignore target process) (let (,@(cl-loop for i from 0 for arg in (delq '&optional arguments) @@ -3256,7 +3295,7 @@ PROCESS is the process object for the current connection." (with-current-buffer chat-buffer (rcirc-print process sender "NICK" old-nick new-nick) (setq rcirc-target new-nick) - (rename-buffer (rcirc-generate-new-buffer-name process new-nick))) + (rename-buffer (rcirc-generate-new-buffer-name process new-nick) t)) (setf rcirc-buffer-alist (cons (cons new-nick chat-buffer) (delq (assoc-string old-nick rcirc-buffer-alist t) |