1
Fork 0
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:
F. Jason Park 2025-04-08 23:17:21 -07:00
parent 8f18b398a5
commit c0cb59578b
3 changed files with 90 additions and 97 deletions

View file

@ -832,17 +832,23 @@ 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.
#'erc--server-reconnect-timeout-double) (defvar erc--server-reconnect-timeout-check 10)
(defvar erc--server-reconnect-timeout-scale-function
#'erc--server-reconnect-timeout-double)
(defun erc--server-reconnect-timeout-double (existing) (defun erc--server-reconnect-timeout-double (existing)
"Double EXISTING timeout, but cap it at 5 minutes." "Double EXISTING timeout, but cap it at 5 minutes."
@ -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))
(with-current-buffer buffer ((buffer-live-p buffer))
(let ((erc-server-reconnect-timeout erc--server-reconnect-timeout)) (buffer)))
;; FIXME either remove this deletion or explain why the one (current-buffer))))
;; performed by `erc-schedule-reconnect' is insufficient. (with-current-buffer buffer
;; Perhaps because `proc' may not equal `erc-server-process'? (let ((erc-server-reconnect-timeout
(when proc ; conn refused w/o :nowait (or erc--server-reconnect-timeout
(delete-process proc)) erc-server-reconnect-timeout)))
(erc-display-message nil '(notice error) buffer (when (and proc (not (eq proc erc-server-process)))
'recon-probe-nobody-home) (set-process-sentinel proc #'ignore)
(erc-schedule-reconnect buffer 0)))))) (delete-process proc))
(erc-display-message nil '(notice error) buffer
'recon-probe-nobody-home)
(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

View file

@ -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")))

View file

@ -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)