From b3cfa19b23833572ec4c4d987eecd5badfb50ca3 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 20 Jan 2025 16:32:53 -0800 Subject: [PATCH] Reuse client cert for connectivity probing in ERC * lisp/erc/erc-backend.el (erc--server-connect-function) (erc--server-post-dial-function): Rename former to latter because the existing name is better suited for the eventual generalizing of `erc-server-connect' in a future version. (erc-server-connect): Use new name for `erc--server-connect-function', `erc--server-post-dial-function'. (erc--recon-probe-reschedule, erc--recon-probe-sentinel) (erc--recon-probe-filter, erc--recon-probe-check): New functions factored out of `erc-server-delayed-check-reconnect'. (erc-server-delayed-check-reconnect): Refactor, splitting off lambdas into top-level functions for improved tracing. * lisp/erc/erc.el (erc-message-english-recon-probe-hung-up) (erc-message-english-recon-probe-nobody-home): New variables. (Bug#62044) Thanks to Libera.Chat user arjan for reporting this bug, which is new in ERC 5.6 and Emacs 30.1. (cherry picked from commit 331bcfaee51f7fa5ff0f6046f30e940452f3a8fe) --- lisp/erc/erc-backend.el | 193 ++++++++++++++++++++++++---------------- lisp/erc/erc.el | 2 + 2 files changed, 119 insertions(+), 76 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 0cf8d56bd70..5823cfc5bae 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -716,7 +716,8 @@ The current buffer is given by BUFFER." (run-hooks 'erc--server-post-connect-hook) (erc-login)) -(defvar erc--server-connect-function #'erc--server-propagate-failed-connection +(defvar erc--server-post-dial-function + #'erc--server-propagate-failed-connection "Function called one second after creating a server process. Called with the newly created process just before the opening IRC protocol exchange.") @@ -795,7 +796,7 @@ TLS (see `erc-session-client-certificate' for more details)." (let ((erc--msg-prop-overrides `((erc--skip . (stamp)) ,@erc--msg-prop-overrides))) (erc-display-message nil nil buffer "Opening connection..\n") - (run-at-time 1 nil erc--server-connect-function process)) + (run-at-time 1 nil erc--server-post-dial-function process)) (message "%s...done" msg) (erc--register-connection)))) @@ -846,89 +847,129 @@ Make sure you are in an ERC buffer when running this." "Double EXISTING timeout, but cap it at 5 minutes." (min 300 (* existing 2))) -;; This may appear to hang at various places. It's assumed that when -;; *Messages* contains "Waiting for socket ..." or similar, progress -;; will be made eventually. - +(defun erc--recon-probe-reschedule (proc) + "Print a message saying PROC's intended peer can't be reached. +Then call `erc-schedule-reconnect'." + (let ((buffer (process-buffer proc))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((erc-server-reconnect-timeout erc--server-reconnect-timeout)) + ;; FIXME either remove this deletion or explain why the one + ;; performed by `erc-schedule-reconnect' is insufficient. + ;; Perhaps because `proc' may not equal `erc-server-process'? + (when proc ; conn refused w/o :nowait + (delete-process proc)) + (erc-display-message nil '(notice error) buffer + 'recon-probe-nobody-home) + (erc-schedule-reconnect buffer 0)))))) + +(defun erc--recon-probe-sentinel (proc event) + "Send a \"PING\" to PROC's peer on an \"open\" EVENT. +Otherwise, try connecting from scratch again after timeout." + (pcase event + ("open\n" + (let ((cookie (time-convert nil 'integer))) + (process-put proc 'erc--reconnect-cookie cookie) + ;; FIXME account for possible `file-error' when sending. + (run-at-time nil nil #'process-send-string proc + (format "PING %d\r\n" cookie)))) + ((and "connection broken by remote peer\n" + (guard (process-get proc 'erc--reconnect-cookie)) + (let buffer (process-buffer proc)) + (guard (buffer-live-p buffer))) + ;; This can run, for example, if the client dials a TLS-terminating + ;; endpoint with a non-TLS opener, like `erc-open-tls-stream', or + ;; if the server doesn't take kindly to an opening "PING" during + ;; connection registration. + (with-current-buffer buffer + (delete-process proc) + ;; Undo latest penalizing timeout increment. + (setq erc--server-reconnect-timeout + (max 1 (/ erc--server-reconnect-timeout 2))) + (erc-display-message nil '(notice error) buffer 'recon-probe-hung-up + ?t erc--server-reconnect-timeout) + (run-at-time erc--server-reconnect-timeout + nil #'erc-server-delayed-reconnect buffer))) + ((or "connection broken by remote peer\n" (rx bot "failed")) + (run-at-time nil nil #'erc--recon-probe-reschedule proc)))) + +(defun erc--recon-probe-filter (proc string) + "Reconnect, reusing PROC if STRING contains a \"PONG\"." + (when-let* ((buffer (process-buffer proc)) + (buffer-live-p buffer)) + (with-current-buffer buffer + (setq erc--server-reconnect-timeout nil)) + (if-let* ; reuse proc if string has complete message + ((cookie (process-get proc 'erc--reconnect-cookie)) + ;; Accommodate a leading ": ". + ((string-suffix-p (format "PONG %d\r\n" cookie) string))) + (progn + (erc-log-irc-protocol string nil) + (set-process-sentinel proc #'ignore) + (set-process-filter proc nil) + (run-at-time nil nil #'erc-server--reconnect-opened buffer proc)) + (delete-process proc) + (run-at-time nil nil #'erc-server-delayed-reconnect buffer)))) + +(defun erc--recon-probe-check (proc tmrx) + "Restart auto-reconnect probe if PROC has failed or TIMER has EXPIRE'd. +Expect TMRX to be a cons cell of (EXPIRE . TIMER)." + (let* ((status (process-status proc)) + (expiredp (time-less-p (pop tmrx) (current-time))) + (buffer (process-buffer proc))) + (when (or expiredp + (not (eq 'connect status)) ; e.g., `closed' + (not (buffer-live-p buffer))) + (cancel-timer tmrx)) + (cond ((not (buffer-live-p buffer))) + (expiredp + (erc-display-message nil 'error buffer "Timed out while dialing...") + (delete-process proc) + (erc--recon-probe-reschedule proc)) + ((eq 'failed status) + (erc--recon-probe-reschedule proc))))) + +;; This probing strategy may appear to hang at various junctures. It's +;; assumed that when *Messages* contains "Waiting for socket ..." or +;; similar, progress will be made eventually. (defun erc-server-delayed-check-reconnect (buffer) "Wait for internet connectivity before trying to reconnect. Use server BUFFER's cached session info to reestablish the logical -connection at the IRC protocol level. Do this by probing for a -successful response to a PING before commencing with \"connection -registration\". Do not distinguish between configuration problems and -the absence of service. For example, expect users of proxy-based -connectors, like `erc-open-socks-tls-stream', to ensure their setup -works before choosing this function as their reconnector." +connection at the IRC protocol level. Do this by probing for any +response to a PING, including a hang up, before (possibly) dialing again +and commencing with \"connection registration\". Make no distinction +between configuration issues and the absence of service in printed +feedback. For example, expect users of proxy-based connectors, like +`erc-open-socks-tls-stream', to ensure their setup works before choosing +this function as their reconnector." (when (buffer-live-p buffer) (with-current-buffer buffer (setq erc--server-reconnect-timeout (funcall erc--server-reconnect-timeout-scale-function (or erc--server-reconnect-timeout erc-server-reconnect-timeout))) - (let* ((reschedule (lambda (proc) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((erc-server-reconnect-timeout - erc--server-reconnect-timeout)) - (when proc ; conn refused w/o :nowait - (delete-process proc)) - (erc-display-message nil 'error buffer - "Nobody home...") - (erc-schedule-reconnect buffer 0)))))) - (conchk-exp (time-add erc--server-reconnect-timeout-check - (current-time))) - (conchk-timer nil) - (conchk (lambda (proc) - (let ((status (process-status proc)) - (xprdp (time-less-p conchk-exp (current-time)))) - (when (or xprdp (not (eq 'connect status))) - (cancel-timer conchk-timer)) - (when (buffer-live-p buffer) - (cond (xprdp (erc-display-message - nil 'error buffer - "Timed out while dialing...") - (delete-process proc) - (funcall reschedule proc)) - ((eq 'failed status) - (funcall reschedule proc))))))) - (sentinel (lambda (proc event) - (pcase event - ("open\n" - (let ((cookie (time-convert nil 'integer))) - (process-put proc 'erc--reconnect-cookie cookie) - (run-at-time nil nil #'process-send-string proc - (format "PING %d\r\n" cookie)))) - ((or "connection broken by remote peer\n" - (rx bot "failed")) - (run-at-time nil nil reschedule proc))))) - (filter (lambda (proc string) - (with-current-buffer buffer - (setq erc--server-reconnect-timeout nil)) - (if-let* ; reuse proc if string has complete message - ((cookie (process-get proc 'erc--reconnect-cookie)) - ((string-suffix-p (format "PONG %d\r\n" cookie) - string))) ; leading ": " - (progn - (erc-log-irc-protocol string nil) - (set-process-sentinel proc #'ignore) - (set-process-filter proc nil) - (run-at-time nil nil - #'erc-server--reconnect-opened - buffer proc)) - (delete-process proc) - (run-at-time nil nil #'erc-server-delayed-reconnect - buffer))))) - (condition-case _ - (let ((proc (funcall erc-session-connector - "*erc-connectivity-check*" nil - erc-session-server erc-session-port))) - (setq conchk-timer (run-at-time 1 1 conchk proc)) - (set-process-filter proc filter) - (set-process-sentinel proc sentinel) - (when (eq (process-status proc) 'open) ; :nowait is nil - (funcall sentinel proc "open\n"))) - ;; E.g., "make client process failed" "Connection refused". - (file-error (funcall reschedule nil))))))) + (condition-case _ + (let* ((cert erc-session-client-certificate) + (tmrx (list (time-add erc--server-reconnect-timeout-check + (current-time)))) + (server (if (string-match erc--server-connect-dumb-ipv6-regexp + erc-session-server) + (match-string 1 erc-session-server) + erc-session-server)) + (proc (apply erc-session-connector "*erc-connectivity-check*" + nil server erc-session-port + (and cert (list :client-certificate cert))))) + (setcdr tmrx (run-at-time 1 1 #'erc--recon-probe-check proc tmrx)) + (set-process-filter proc #'erc--recon-probe-filter) + (set-process-sentinel proc #'erc--recon-probe-sentinel) + (set-process-buffer proc buffer) + ;; Should `erc-server-process' also be set to `proc' here so + ;; that `erc-schedule-reconnect' can use it? + (cl-assert (processp proc)) + (when (eq (process-status proc) 'open) ; :nowait is nil + (erc--recon-probe-sentinel proc "open\n"))) + ;; E.g., "make client process failed" "Connection refused". + (file-error (erc--recon-probe-reschedule nil)))))) (defun erc-server-prefer-check-reconnect (buffer) "Defer to another reconnector based on BUFFER's `erc-session-connector'. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ea208d2be58..baf154f884e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9525,6 +9525,8 @@ SOFTP, only do so when defined as a variable." (ignore-list . "%-8p %s") (reconnecting . "Reconnecting in %ms: attempt %i/%n ...") (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...") + (recon-probe-hung-up . "Server answered but hung up. Delaying by %ts...") + (recon-probe-nobody-home . "Nobody home...") (finished . "\n\n*** ERC finished ***\n") (terminated . "\n\n*** ERC terminated: %e\n") (login . "Logging in as `%n'...") -- 2.39.5