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.
This commit is contained in:
F. Jason Park
parent
d6b210aa09
commit
331bcfaee5
2 changed files with 118 additions and 75 deletions
|
|
@ -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 ":<source> ".
|
||||
((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 ":<source> "
|
||||
(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'.
|
||||
|
|
|
|||
|
|
@ -9572,6 +9572,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'...")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue