>From a1d77151295d4c177ea75c723684873cc94875ed Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 11 Mar 2023 06:46:19 -0800 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [5.6] Add probing erc-server-reconnect-function variant lisp/erc/erc-backend.el | 116 ++++++++++++++- .../lisp/erc/erc-scenarios-base-auto-recon.el | 140 ++++++++++++++++++ .../erc/resources/base/reconnect/just-eof.eld | 3 + .../resources/base/reconnect/just-ping.eld | 4 + .../resources/base/reconnect/ping-pong.eld | 6 + .../base/reconnect/unexpected-disconnect.eld | 24 +++ .../erc/resources/erc-scenarios-common.el | 1 + 7 files changed, 289 insertions(+), 5 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-auto-recon.el create mode 100644 test/lisp/erc/resources/base/reconnect/just-eof.eld create mode 100644 test/lisp/erc/resources/base/reconnect/just-ping.eld create mode 100644 test/lisp/erc/resources/base/reconnect/ping-pong.eld create mode 100644 test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld Interdiff: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 1030672506e..c6f263fdfba 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -415,8 +415,10 @@ erc-server-reconnect-attempts (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 @@ erc-server-reconnect-function 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 @@ -667,18 +670,17 @@ erc--server-propagate-failed-connection "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. Print the -`process-exit-status', which can be a number, like 111, or a -message, like \"TLS negotiation failed\"." +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) - ((guard erc--server-reconnect-timer)) (111 - (delete-process process)) - (`(file-error ,(rx "failed") ,(rx "unreachable") . ,_) + (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"))))) @@ -733,7 +735,7 @@ erc-server-connect (with-current-buffer buffer (erc-current-nick)))) ;; wait with script loading until we receive a confirmation (first ;; MOTD line) - (if (process-contact process :nowait) + (if (eq (process-status process) 'connect) ;; waiting for a non-blocking connect - keep the user informed (progn (erc-display-message nil nil buffer "Opening connection..\n") @@ -772,66 +774,76 @@ erc-server-delayed-reconnect (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 (* (or existing erc-server-reconnect-timeout) 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. BUFFER is the server buffer for the current connection." - ;; This may appear to hang for a good while at various places - ;; because it calls wait_reading_process_output a bunch. It does at - ;; least sometimes print "Waiting for socket from ..." or similar. - (with-current-buffer buffer - (setq erc--server-reconnect-timeout - (min 300 (* (or erc--server-reconnect-timeout - erc-server-reconnect-timeout) - 2))) - (let ((reschedule - (lambda (proc) - (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)))))) - (condition-case _ - (let ((proc (funcall erc-session-connector - "*erc-connectivity-check" nil - erc-session-server erc-session-port - :nowait t)) - (check-expire (time-add 10 (current-time))) - check-aside) - (setq check-aside - (run-at-time - 1 1 (lambda (proc) - (when (or (not (eq 'connect (process-status proc))) - (time-less-p check-expire (current-time))) - (cancel-timer check-aside)) - (when (time-less-p check-expire (current-time)) - (erc-display-message - nil 'error buffer "Timed out waiting on `connect'") - (delete-process proc) - (funcall reschedule proc)) - (when (eq 'failed (process-status proc)) - (funcall reschedule proc))) - proc)) - (set-process-filter - proc (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))) - (set-process-sentinel - proc (lambda (proc event) - (with-current-buffer buffer - (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))))))) - (file-error (funcall reschedule nil)))))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (setq erc--server-reconnect-timeout + (funcall erc--server-reconnect-timeout-scale-function + 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)) + (top (time-less-p conchk-exp (current-time)))) + (when (or (not (eq 'connect status)) top) + (cancel-timer conchk-timer)) + (when (buffer-live-p buffer) + (cond (top (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." @@ -912,11 +924,16 @@ erc-schedule-reconnect `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..719cf4e3b5d --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-auto-recon.el @@ -0,0 +1,140 @@ +;;; 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 . + +;;; 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-scenarios-common--print-trace (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) -- 2.39.2