diff options
| -rw-r--r-- | lisp/erc/erc-backend.el | 116 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-base-auto-recon.el | 141 | ||||
| -rw-r--r-- | test/lisp/erc/resources/base/reconnect/just-eof.eld | 3 | ||||
| -rw-r--r-- | test/lisp/erc/resources/base/reconnect/just-ping.eld | 4 | ||||
| -rw-r--r-- | test/lisp/erc/resources/base/reconnect/ping-pong.eld | 6 | ||||
| -rw-r--r-- | test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld | 24 | ||||
| -rw-r--r-- | test/lisp/erc/resources/erc-scenarios-common.el | 1 |
7 files changed, 290 insertions, 5 deletions
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bf3c2b5b308..acfbe3ef3a6 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -415,8 +415,10 @@ This only has an effect if `erc-server-auto-reconnect' is non-nil." (defcustom erc-server-reconnect-timeout 1 "Number of seconds to wait between successive reconnect attempts. - -If a key is pressed while ERC is waiting, it will stop waiting." +If this value is too low, servers may reject your initial nick +request upon reconnecting because they haven't yet noticed that +your previous connection is dead. If this happens, try setting +this value to 120 or greater." :type 'number) (defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect @@ -427,6 +429,7 @@ dialing. Use `erc-schedule-reconnect' to instead try again later and optionally alter the attempts tally." :package-version '(ERC . "5.5") :type '(choice (function-item erc-server-delayed-reconnect) + (function-item erc-server-delayed-check-reconnect) function)) (defcustom erc-split-line-length 440 @@ -658,6 +661,30 @@ 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 + "Function called one second after creating a server process. +Called with the newly created process just before the opening IRC +protocol exchange.") + +(defun erc--server-propagate-failed-connection (process) + "Ensure the PROCESS sentinel runs at least once on early failure. +Act as a watchdog timer to force `erc-process-sentinel' and its +finalizers, like `erc-disconnected-hook', to run when PROCESS has +a status of `failed' after one second. But only do so when its +error data is something ERC recognizes. Print an explanation to +the server buffer in any case." + (when (eq (process-status process) 'failed) + (erc-display-message + nil 'error (process-buffer process) + (format "Process exit status: %S" (process-exit-status process))) + (pcase (process-exit-status process) + (111 + (erc-process-sentinel process "failed with code 111\n")) + (`(file-error . ,_) + (erc-process-sentinel process "failed with code -523\n")) + ((rx "tls" (+ nonl) "failed") + (erc-process-sentinel process "failed with code -525\n"))))) + (defvar erc--server-connect-dumb-ipv6-regexp ;; Not for validation (gives false positives). (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot)) @@ -710,7 +737,9 @@ TLS (see `erc-session-client-certificate' for more details)." ;; MOTD line) (if (eq (process-status process) 'connect) ;; waiting for a non-blocking connect - keep the user informed - (erc-display-message nil nil buffer "Opening connection..\n") + (progn + (erc-display-message nil nil buffer "Opening connection..\n") + (run-at-time 1 nil erc--server-connect-function process)) (message "%s...done" msg) (erc--register-connection)))) @@ -744,6 +773,78 @@ Make sure you are in an ERC buffer when running this." (with-current-buffer buffer (erc-server-reconnect)))) +(defvar-local erc--server-reconnect-timeout nil) +(defvar-local erc--server-reconnect-timeout-check 10) +(defvar-local erc--server-reconnect-timeout-scale-function + #'erc--server-reconnect-timeout-double) + +(defun erc--server-reconnect-timeout-double (existing) + "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-server-delayed-check-reconnect (buffer) + "Wait for internet connectivity before trying to reconnect. +Expect BUFFER to be the server buffer for the current connection." + (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)) + (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 (not (eq 'connect status)) xprdp) + (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" + (run-at-time nil nil #'send-string proc + (format "PING %d\r\n" + (time-convert nil 'integer)))) + ((or "connection broken by remote peer\n" + (rx bot "failed")) + (funcall reschedule proc))))) + (filter (lambda (proc _) + (delete-process proc) + (with-current-buffer buffer + (setq erc--server-reconnect-timeout nil)) + (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 + :nowait t))) + (setq conchk-timer (run-at-time 1 1 conchk proc)) + (set-process-filter proc filter) + (set-process-sentinel proc sentinel)) + (file-error (funcall reschedule nil))))))) + (defun erc-server-filter-function (process string) "The process filter for the ERC server." (with-current-buffer (process-buffer process) @@ -823,11 +924,16 @@ When `erc-server-reconnect-attempts' is a number, increment `erc-server-reconnect-count' by INCR unconditionally." (let ((count (and (integerp erc-server-reconnect-attempts) (- erc-server-reconnect-attempts - (cl-incf erc-server-reconnect-count (or incr 1)))))) - (erc-display-message nil 'error (current-buffer) 'reconnecting + (cl-incf erc-server-reconnect-count (or incr 1))))) + (proc (buffer-local-value 'erc-server-process buffer))) + (erc-display-message nil 'error buffer 'reconnecting ?m erc-server-reconnect-timeout ?i (if count erc-server-reconnect-count "N") ?n (if count erc-server-reconnect-attempts "A")) + (set-process-sentinel proc #'ignore) + (set-process-filter proc nil) + (delete-process proc) + (erc-update-mode-line) (setq erc-server-reconnecting nil erc--server-reconnect-timer (run-at-time erc-server-reconnect-timeout nil diff --git a/test/lisp/erc/erc-scenarios-base-auto-recon.el b/test/lisp/erc/erc-scenarios-base-auto-recon.el new file mode 100644 index 00000000000..40e2c23408b --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-auto-recon.el @@ -0,0 +1,141 @@ +;;; erc-scenarios-base-auto-recon.el --- auto-recon scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(defun erc-scenarios-base-auto-recon--get-unused-port () + (let ((server (make-network-process :name "*erc-scenarios-base-auto-recon*" + :host "localhost" + :service t + :server t))) + (delete-process server) + (process-contact server :service))) + +;; This demos one possible flavor of intermittent service. +;; It may end up needing to be marked :unstable. + +(ert-deftest erc-scenarios-base-auto-recon-unavailable () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (port (erc-scenarios-base-auto-recon--get-unused-port)) + (erc--server-reconnect-timeout-scale-function (lambda (_) 1)) + (erc-server-auto-reconnect t) + (erc-server-reconnect-function #'erc-server-delayed-check-reconnect) + (expect (erc-d-t-make-expecter)) + (erc-scenarios-common-dialog "base/reconnect") + (dumb-server nil)) + + (ert-info ("Dialing fails: nobody home") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (erc-d-t-wait-for 10 (not (erc-server-process-alive))) + (erc-d-t-wait-for 10 erc--server-reconnect-timer) + (funcall expect 10 "Opening connection") + (funcall expect 10 "failed") + + (ert-info ("Reconnect function freezes attempts at 1") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")) + (funcall expect 10 "nobody home") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")) + (funcall expect 10 "nobody home")))) + + (ert-info ("Service appears") + (setq dumb-server (erc-d-run "localhost" port + 'just-eof 'unexpected-disconnect)) + (with-current-buffer (format "127.0.0.1:%d" port) + (funcall expect 10 "server is in debug mode") + (should (equal (buffer-name) "FooNet")))) + + (ert-info ("Service interrupted, reconnect starts again") + (with-current-buffer "FooNet" + (funcall expect 10 "failed") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")))) + + (ert-info ("Service restored") + (delete-process dumb-server) + (setq dumb-server (erc-d-run "localhost" port + 'just-eof 'unexpected-disconnect)) + (with-current-buffer "FooNet" + (funcall expect 10 "server is in debug mode"))) + + (ert-info ("Service interrupted a third time, reconnect starts yet again") + (with-current-buffer "FooNet" + (funcall expect 10 "failed") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")) + (erc-cmd-RECONNECT "cancel") + (funcall expect 10 "canceled"))))) + +;; In this test, a listener accepts but doesn't respond to any messages. + +(ert-deftest erc-scenarios-base-auto-recon-no-proto () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-server-flood-penalty 0.1) + (erc-scenarios-common-dialog "base/reconnect") + (erc-d-auto-pong nil) + (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) + (port (process-contact dumb-server :service)) + (erc--server-reconnect-timeout-scale-function (lambda (_) 1)) + (erc--server-reconnect-timeout-check 0.5) + (erc-server-auto-reconnect t) + (erc-server-reconnect-function #'erc-server-delayed-check-reconnect) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Session succeeds but cut short") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "server is in debug mode") + (should (equal (buffer-name) "FooNet")) + (erc-d-t-wait-for 10 erc--server-reconnect-timer) + (delete-process dumb-server) + (funcall expect 10 "failed") + + (ert-info ("Reconnect function freezes attempts at 1") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")) + (funcall expect 10 "nobody home") + (funcall expect 10 "timed out while dialing") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")) + (funcall expect 10 "nobody home")))) + + (ert-info ("Service restored") + (setq dumb-server (erc-d-run "localhost" port + 'just-ping + 'ping-pong + 'unexpected-disconnect)) + (with-current-buffer "FooNet" + (funcall expect 30 "server is in debug mode"))) + + (ert-info ("Service interrupted again, reconnect starts again") + (with-current-buffer "FooNet" + (funcall expect 10 "failed") + (funcall expect 10 '(: "reconnecting" (+ nonl) "attempt 1/2")) + (erc-cmd-RECONNECT "cancel") + (funcall expect 10 "canceled"))))) + +;;; erc-scenarios-base-auto-recon.el ends here diff --git a/test/lisp/erc/resources/base/reconnect/just-eof.eld b/test/lisp/erc/resources/base/reconnect/just-eof.eld new file mode 100644 index 00000000000..c80a39b3170 --- /dev/null +++ b/test/lisp/erc/resources/base/reconnect/just-eof.eld @@ -0,0 +1,3 @@ +;; -*- mode: lisp-data; -*- +((eof 5 EOF)) +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/reconnect/just-ping.eld b/test/lisp/erc/resources/base/reconnect/just-ping.eld new file mode 100644 index 00000000000..d57888b42d3 --- /dev/null +++ b/test/lisp/erc/resources/base/reconnect/just-ping.eld @@ -0,0 +1,4 @@ +;; -*- mode: lisp-data; -*- +((ping 20 "PING")) + +((eof 10 EOF)) diff --git a/test/lisp/erc/resources/base/reconnect/ping-pong.eld b/test/lisp/erc/resources/base/reconnect/ping-pong.eld new file mode 100644 index 00000000000..b3d36cf6cec --- /dev/null +++ b/test/lisp/erc/resources/base/reconnect/ping-pong.eld @@ -0,0 +1,6 @@ +;; -*- mode: lisp-data; -*- +((ping 10 "PING ") + (0 "PONG fake")) + +((eof 10 EOF)) +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld b/test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld new file mode 100644 index 00000000000..386d0f4b085 --- /dev/null +++ b/test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld @@ -0,0 +1,24 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") + (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 05:06:18 UTC") + (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0 ":irc.foonet.org 254 tester 1 :channels formed") + (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.foonet.org 221 tester +i") + (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((drop 0 DROP)) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 0d9a79ae9ce..f259c88594b 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -121,6 +121,7 @@ (erc-modules (copy-sequence erc-modules)) (inhibit-interaction t) (auth-source-do-cache nil) + (timer-list (copy-sequence timer-list)) (erc-auth-source-parameters-join-function nil) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) |