mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Don't round-trip auto-reconnect probe in ERC
* lisp/erc/erc-backend.el (erc-server--reconnect-opened) (erc--server-reconnect-opened): Rename former to latter. Restore original buffer-local value of session connector for Emacs 29 and below. (erc--server-reconnect-timeout-check) (erc--server-reconnect-timeout-scale-function): Change from buffer-local to normal variables, which they should have been originally. (erc--recon-probe-reschedule): Ensure `erc-server-reconnect-timeout' is always non-nil to avoid seeing format specifier in admin message. Use current buffer when `proc' argument is nil. Perform cleanup when `proc' and `erc-server-process' differ. (erc-server-delayed-check-reconnect-reuse-process-p): New variable. (erc--recon-probe-sentinel): Run `erc--server-reconnect-opened' immediately because sending a speculative PING doesn't work on all servers and proxies, most crucially on ZNC, which replies with an error only after an extended timeout. (erc--recon-probe-filter): Remove unused function. (erc--recon-probe-check) Rework to not use fixed periodic timer, change second parameter to a Lisp time object. (erc-server-delayed-check-reconnect): Use realistic name when reusing process so that the session's process isn't "*erc-connectivity-check*". Set filter to `ignore'. Always run `erc--recon-probe-sentinel' when status is `open' or something other than `connect', but don't bother spawning a `erc--recon-probe-check' task as well because any problems creating the process should already be known. Handle quits during connect functions that perform blocking I/O, such as `socks-open-network-stream'. (erc-schedule-reconnect): Don't bother setting filter to nil. * test/lisp/erc/erc-scenarios-base-auto-recon.el (erc-scenarios-base-auto-recon-unavailable) (erc-scenarios-base-auto-recon-check/no-reuse): Rename former to latter. (erc-scenarios-base-auto-recon-no-proto) (erc-scenarios-base-auto-recon-check/reuse): Rename former to latter and rewrite not to expect a PING. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--forget-process): New function. (erc-d--process-sentinel): Stop serving when all dialogs have been exhausted. (Bug#62044)
This commit is contained in:
parent
8f18b398a5
commit
c0cb59578b
3 changed files with 90 additions and 97 deletions
|
|
@ -832,16 +832,22 @@ Make sure you are in an ERC buffer when running this."
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(erc-server-reconnect))))
|
(erc-server-reconnect))))
|
||||||
|
|
||||||
(defun erc-server--reconnect-opened (buffer process)
|
(defun erc--server-reconnect-opened (buffer process)
|
||||||
"Reconnect session for server BUFFER using open PROCESS."
|
"Reconnect session for server BUFFER using open PROCESS."
|
||||||
(when (buffer-live-p buffer)
|
(when (buffer-live-p buffer)
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(let ((erc-session-connector (lambda (&rest _) process)))
|
(let* ((orig erc-session-connector)
|
||||||
|
(erc-session-connector
|
||||||
|
(lambda (&rest _)
|
||||||
|
(setq erc-session-connector orig)
|
||||||
|
process)))
|
||||||
(erc-server-reconnect)))))
|
(erc-server-reconnect)))))
|
||||||
|
|
||||||
(defvar-local erc--server-reconnect-timeout nil)
|
(defvar-local erc--server-reconnect-timeout nil)
|
||||||
(defvar-local erc--server-reconnect-timeout-check 10)
|
|
||||||
(defvar-local erc--server-reconnect-timeout-scale-function
|
;; These variables exist for use in unit tests.
|
||||||
|
(defvar erc--server-reconnect-timeout-check 10)
|
||||||
|
(defvar erc--server-reconnect-timeout-scale-function
|
||||||
#'erc--server-reconnect-timeout-double)
|
#'erc--server-reconnect-timeout-double)
|
||||||
|
|
||||||
(defun erc--server-reconnect-timeout-double (existing)
|
(defun erc--server-reconnect-timeout-double (existing)
|
||||||
|
|
@ -851,84 +857,57 @@ Make sure you are in an ERC buffer when running this."
|
||||||
(defun erc--recon-probe-reschedule (proc)
|
(defun erc--recon-probe-reschedule (proc)
|
||||||
"Print a message saying PROC's intended peer can't be reached.
|
"Print a message saying PROC's intended peer can't be reached.
|
||||||
Then call `erc-schedule-reconnect'."
|
Then call `erc-schedule-reconnect'."
|
||||||
(let ((buffer (process-buffer proc)))
|
(let ((buffer (or (and-let* ((proc)
|
||||||
(when (buffer-live-p buffer)
|
(buffer (process-buffer proc))
|
||||||
|
((buffer-live-p buffer))
|
||||||
|
(buffer)))
|
||||||
|
(current-buffer))))
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(let ((erc-server-reconnect-timeout erc--server-reconnect-timeout))
|
(let ((erc-server-reconnect-timeout
|
||||||
;; FIXME either remove this deletion or explain why the one
|
(or erc--server-reconnect-timeout
|
||||||
;; performed by `erc-schedule-reconnect' is insufficient.
|
erc-server-reconnect-timeout)))
|
||||||
;; Perhaps because `proc' may not equal `erc-server-process'?
|
(when (and proc (not (eq proc erc-server-process)))
|
||||||
(when proc ; conn refused w/o :nowait
|
(set-process-sentinel proc #'ignore)
|
||||||
(delete-process proc))
|
(delete-process proc))
|
||||||
(erc-display-message nil '(notice error) buffer
|
(erc-display-message nil '(notice error) buffer
|
||||||
'recon-probe-nobody-home)
|
'recon-probe-nobody-home)
|
||||||
(erc-schedule-reconnect buffer 0))))))
|
(erc-schedule-reconnect buffer 0)))))
|
||||||
|
|
||||||
|
(defvar erc-server-delayed-check-reconnect-reuse-process-p t
|
||||||
|
"Whether to reuse a successful probe as the session process.")
|
||||||
|
|
||||||
(defun erc--recon-probe-sentinel (proc event)
|
(defun erc--recon-probe-sentinel (proc event)
|
||||||
"Send a \"PING\" to PROC's peer on an \"open\" EVENT.
|
"Send a \"PING\" to PROC's peer on an \"open\" EVENT.
|
||||||
Otherwise, try connecting from scratch again after timeout."
|
Otherwise, try connecting from scratch again after timeout."
|
||||||
(pcase event
|
(pcase event
|
||||||
("open\n"
|
("open\n"
|
||||||
(let ((cookie (time-convert nil 'integer)))
|
(set-process-sentinel proc #'ignore)
|
||||||
(process-put proc 'erc--reconnect-cookie cookie)
|
;; This has been observed to possibly raise a `file-error'.
|
||||||
;; FIXME account for possible `file-error' when sending.
|
(if erc-server-delayed-check-reconnect-reuse-process-p
|
||||||
(run-at-time nil nil #'process-send-string proc
|
(run-at-time nil nil #'erc--server-reconnect-opened
|
||||||
(format "PING %d\r\n" cookie))))
|
(process-buffer proc) proc)
|
||||||
((and "connection broken by remote peer\n"
|
(run-at-time nil nil #'delete-process proc)
|
||||||
(guard (process-get proc 'erc--reconnect-cookie))
|
(run-at-time nil nil #'erc-server-delayed-reconnect
|
||||||
(let buffer (process-buffer proc))
|
(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"))
|
((or "connection broken by remote peer\n" (rx bot "failed"))
|
||||||
(run-at-time nil nil #'erc--recon-probe-reschedule proc))))
|
(run-at-time nil nil #'erc--recon-probe-reschedule proc))))
|
||||||
|
|
||||||
(defun erc--recon-probe-filter (proc string)
|
(defun erc--recon-probe-check (proc expire)
|
||||||
"Reconnect, reusing PROC if STRING contains a \"PONG\"."
|
"Restart reconnect probe if PROC has failed or EXPIRE time has passed.
|
||||||
(when-let* ((buffer (process-buffer proc))
|
Otherwise, if PROC's buffer is live and its status is `connect', arrange
|
||||||
(buffer-live-p buffer))
|
for running again in 1 second."
|
||||||
(with-current-buffer buffer
|
(let* ((buffer (process-buffer proc))
|
||||||
(setq erc--server-reconnect-timeout nil))
|
;;
|
||||||
(if-let* ; reuse proc if string has complete message
|
status)
|
||||||
((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)))
|
(cond ((not (buffer-live-p buffer)))
|
||||||
(expiredp
|
((time-less-p expire (current-time))
|
||||||
|
;; TODO convert into proper catalog message for i18n.
|
||||||
(erc-display-message nil 'error buffer "Timed out while dialing...")
|
(erc-display-message nil 'error buffer "Timed out while dialing...")
|
||||||
(delete-process proc)
|
|
||||||
(erc--recon-probe-reschedule proc))
|
(erc--recon-probe-reschedule proc))
|
||||||
((eq 'failed status)
|
((eq (setq status (process-status proc)) 'failed)
|
||||||
(erc--recon-probe-reschedule proc)))))
|
(erc--recon-probe-reschedule proc))
|
||||||
|
((eq status 'connect)
|
||||||
|
(run-at-time 1 nil #'erc--recon-probe-check proc expire)))))
|
||||||
|
|
||||||
;; This probing strategy may appear to hang at various junctures. It's
|
;; This probing strategy may appear to hang at various junctures. It's
|
||||||
;; assumed that when *Messages* contains "Waiting for socket ..." or
|
;; assumed that when *Messages* contains "Waiting for socket ..." or
|
||||||
|
|
@ -951,26 +930,31 @@ this function as their reconnector."
|
||||||
erc-server-reconnect-timeout)))
|
erc-server-reconnect-timeout)))
|
||||||
(condition-case _
|
(condition-case _
|
||||||
(let* ((cert erc-session-client-certificate)
|
(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
|
(server (if (string-match erc--server-connect-dumb-ipv6-regexp
|
||||||
erc-session-server)
|
erc-session-server)
|
||||||
(match-string 1 erc-session-server)
|
(match-string 1 erc-session-server)
|
||||||
erc-session-server))
|
erc-session-server))
|
||||||
(proc (apply erc-session-connector "*erc-connectivity-check*"
|
(name (if erc-server-delayed-check-reconnect-reuse-process-p
|
||||||
|
(format "erc-%s-%s" server erc-session-port)
|
||||||
|
"*erc-connectivity-check*"))
|
||||||
|
(proc (apply erc-session-connector name
|
||||||
nil server erc-session-port
|
nil server erc-session-port
|
||||||
(and cert (list :client-certificate cert)))))
|
(and cert (list :client-certificate cert))))
|
||||||
(setcdr tmrx (run-at-time 1 1 #'erc--recon-probe-check proc tmrx))
|
(status (process-status proc)))
|
||||||
(set-process-filter proc #'erc--recon-probe-filter)
|
|
||||||
(set-process-sentinel proc #'erc--recon-probe-sentinel)
|
|
||||||
(set-process-buffer proc buffer)
|
(set-process-buffer proc buffer)
|
||||||
;; Should `erc-server-process' also be set to `proc' here so
|
(set-process-filter proc #'ignore)
|
||||||
;; that `erc-schedule-reconnect' can use it?
|
(if (not (eq status 'connect)) ; :nowait is nil
|
||||||
(cl-assert (processp proc))
|
(erc--recon-probe-sentinel proc (if (eq status 'open)
|
||||||
(when (eq (process-status proc) 'open) ; :nowait is nil
|
"open\n"
|
||||||
(erc--recon-probe-sentinel proc "open\n")))
|
"failed"))
|
||||||
|
(run-at-time 1 nil #'erc--recon-probe-check proc
|
||||||
|
(time-add erc--server-reconnect-timeout-check
|
||||||
|
(current-time)))
|
||||||
|
(set-process-sentinel proc #'erc--recon-probe-sentinel)))
|
||||||
;; E.g., "make client process failed" "Connection refused".
|
;; E.g., "make client process failed" "Connection refused".
|
||||||
(file-error (erc--recon-probe-reschedule nil))))))
|
(file-error (erc--recon-probe-reschedule nil))
|
||||||
|
;; C-g during blocking connect, like with the SOCKS connector.
|
||||||
|
(quit (erc--cancel-auto-reconnect-timer))))))
|
||||||
|
|
||||||
(defun erc-server-prefer-check-reconnect (buffer)
|
(defun erc-server-prefer-check-reconnect (buffer)
|
||||||
"Defer to another reconnector based on BUFFER's `erc-session-connector'.
|
"Defer to another reconnector based on BUFFER's `erc-session-connector'.
|
||||||
|
|
@ -1085,7 +1069,6 @@ When `erc-server-reconnect-attempts' is a number, increment
|
||||||
?i (if count erc-server-reconnect-count "N")
|
?i (if count erc-server-reconnect-count "N")
|
||||||
?n (if count erc-server-reconnect-attempts "A"))
|
?n (if count erc-server-reconnect-attempts "A"))
|
||||||
(set-process-sentinel proc #'ignore)
|
(set-process-sentinel proc #'ignore)
|
||||||
(set-process-filter proc nil)
|
|
||||||
(delete-process proc)
|
(delete-process proc)
|
||||||
(erc-update-mode-line)
|
(erc-update-mode-line)
|
||||||
(setq erc-server-reconnecting nil
|
(setq erc-server-reconnecting nil
|
||||||
|
|
|
||||||
|
|
@ -39,7 +39,7 @@
|
||||||
;; This demos one possible flavor of intermittent service.
|
;; This demos one possible flavor of intermittent service.
|
||||||
;; It may end up needing to be marked :unstable.
|
;; It may end up needing to be marked :unstable.
|
||||||
|
|
||||||
(ert-deftest erc-scenarios-base-auto-recon-unavailable ()
|
(ert-deftest erc-scenarios-base-auto-recon-check/no-reuse ()
|
||||||
:tags '(:expensive-test)
|
:tags '(:expensive-test)
|
||||||
(erc-scenarios-common-with-cleanup
|
(erc-scenarios-common-with-cleanup
|
||||||
((erc-server-flood-penalty 0.1)
|
((erc-server-flood-penalty 0.1)
|
||||||
|
|
@ -48,6 +48,7 @@
|
||||||
(erc-server-auto-reconnect t)
|
(erc-server-auto-reconnect t)
|
||||||
(expect (erc-d-t-make-expecter))
|
(expect (erc-d-t-make-expecter))
|
||||||
(erc-scenarios-common-dialog "base/reconnect")
|
(erc-scenarios-common-dialog "base/reconnect")
|
||||||
|
(erc-server-delayed-check-reconnect-reuse-process-p nil)
|
||||||
(dumb-server nil))
|
(dumb-server nil))
|
||||||
|
|
||||||
(ert-info ("Dialing fails: nobody home")
|
(ert-info ("Dialing fails: nobody home")
|
||||||
|
|
@ -94,14 +95,12 @@
|
||||||
|
|
||||||
;; Here, a listener accepts but doesn't respond to any messages.
|
;; Here, a listener accepts but doesn't respond to any messages.
|
||||||
|
|
||||||
(ert-deftest erc-scenarios-base-auto-recon-no-proto ()
|
(ert-deftest erc-scenarios-base-auto-recon-check/reuse ()
|
||||||
:tags '(:expensive-test)
|
:tags '(:expensive-test)
|
||||||
|
(should erc-server-delayed-check-reconnect-reuse-process-p)
|
||||||
(erc-scenarios-common-with-cleanup
|
(erc-scenarios-common-with-cleanup
|
||||||
((erc-server-flood-penalty 0.1)
|
((erc-server-flood-penalty 0.1)
|
||||||
(erc-scenarios-common-dialog "base/reconnect")
|
(erc-scenarios-common-dialog "base/reconnect")
|
||||||
(erc-d-auto-pong nil)
|
|
||||||
(erc-d-tmpl-vars
|
|
||||||
`((cookie . ,(lambda (a) (funcall a :set (funcall a :match 1))))))
|
|
||||||
(dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
|
(dumb-server (erc-d-run "localhost" t 'unexpected-disconnect))
|
||||||
(port (process-contact dumb-server :service))
|
(port (process-contact dumb-server :service))
|
||||||
(erc--server-reconnect-timeout-scale-function (lambda (_) 1))
|
(erc--server-reconnect-timeout-scale-function (lambda (_) 1))
|
||||||
|
|
@ -117,19 +116,19 @@
|
||||||
(funcall expect 10 "server is in debug mode")
|
(funcall expect 10 "server is in debug mode")
|
||||||
(should (equal (buffer-name) "FooNet"))
|
(should (equal (buffer-name) "FooNet"))
|
||||||
(erc-d-t-wait-for 10 erc--server-reconnect-timer)
|
(erc-d-t-wait-for 10 erc--server-reconnect-timer)
|
||||||
(delete-process dumb-server)
|
|
||||||
(funcall expect 10 "failed")
|
(funcall expect 10 "failed")
|
||||||
|
|
||||||
(ert-info ("Reconnect function freezes attempts at 1")
|
(ert-info ("Reconnect function freezes attempts at 1")
|
||||||
(funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
|
(funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
|
||||||
(funcall expect 10 "nobody home")
|
(funcall expect 10 "Timed out while dialing")
|
||||||
(funcall expect 10 "timed out while dialing")
|
(funcall expect 10 "Nobody home")
|
||||||
(funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
|
(funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2"))
|
||||||
(funcall expect 10 "nobody home"))))
|
(funcall expect 10 "Timed out while dialing")
|
||||||
|
(funcall expect 10 "Nobody home"))))
|
||||||
|
|
||||||
(ert-info ("Service restored")
|
(ert-info ("Service restored")
|
||||||
|
(delete-process dumb-server)
|
||||||
(setq dumb-server (erc-d-run "localhost" port
|
(setq dumb-server (erc-d-run "localhost" port
|
||||||
'just-ping
|
|
||||||
'unexpected-disconnect))
|
'unexpected-disconnect))
|
||||||
(with-current-buffer "FooNet"
|
(with-current-buffer "FooNet"
|
||||||
(funcall expect 30 "server is in debug mode")))
|
(funcall expect 30 "server is in debug mode")))
|
||||||
|
|
|
||||||
|
|
@ -422,10 +422,19 @@ This will start the teardown for DIALOG."
|
||||||
(make-erc-d-i-message :command "eof" :unparsed erc-d--eof-sentinel))
|
(make-erc-d-i-message :command "eof" :unparsed erc-d--eof-sentinel))
|
||||||
(run-at-time nil nil #'erc-d-command dialog 'eof))
|
(run-at-time nil nil #'erc-d-command dialog 'eof))
|
||||||
|
|
||||||
|
(defun erc-d--forget-process (process)
|
||||||
|
"Set sentinel and filter for PROCESS to `ignore'."
|
||||||
|
(let ((server (process-get process :server)))
|
||||||
|
(set-process-sentinel server #'ignore)
|
||||||
|
(set-process-sentinel process #'ignore)
|
||||||
|
(set-process-filter server #'ignore)
|
||||||
|
(set-process-filter process #'ignore)))
|
||||||
|
|
||||||
(defun erc-d--process-sentinel (process event)
|
(defun erc-d--process-sentinel (process event)
|
||||||
"Set up or tear down client-connection PROCESS depending on EVENT."
|
"Set up or tear down client-connection PROCESS depending on EVENT."
|
||||||
(erc-d--log-process-event process process event)
|
(erc-d--log-process-event process process event)
|
||||||
(if (eq 'open (process-status process))
|
(if (and (eq 'open (process-status process))
|
||||||
|
(process-get process :dialog-dialogs))
|
||||||
(erc-d--initialize-client process)
|
(erc-d--initialize-client process)
|
||||||
(let* ((dialog (process-get process :dialog))
|
(let* ((dialog (process-get process :dialog))
|
||||||
(exes (and dialog (erc-d-dialog-exchanges dialog))))
|
(exes (and dialog (erc-d-dialog-exchanges dialog))))
|
||||||
|
|
@ -435,7 +444,9 @@ This will start the teardown for DIALOG."
|
||||||
;; Ignore disconnecting peer when pattern is DROP
|
;; Ignore disconnecting peer when pattern is DROP
|
||||||
((and (string-prefix-p "deleted" event)
|
((and (string-prefix-p "deleted" event)
|
||||||
(erc-d--drop-p (ring-ref exes -1))))
|
(erc-d--drop-p (ring-ref exes -1))))
|
||||||
(t (erc-d--teardown)))
|
(t (erc-d--forget-process process)
|
||||||
|
(erc-d--teardown)))
|
||||||
|
(erc-d--forget-process process)
|
||||||
(erc-d--teardown)))))
|
(erc-d--teardown)))))
|
||||||
|
|
||||||
(defun erc-d--filter (process string)
|
(defun erc-d--filter (process string)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue