master 03eddc99242 07/37: Add probing erc-server-reconnect-function variant

[F. Jason Park]

branch: master
commit 03eddc99242bb430a82f468251ed76602d457702
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Add probing erc-server-reconnect-function variant
    
    * lisp/erc/erc-backend.el (erc-server-reconnect-timeout): Replace
    questionable claim with recommendation for alternate value when
    experiencing nick rejections.
    (erc-server-reconnect-function): Add new, somewhat experimental value
    `erc-server-delayed-check-reconnect'.
    (erc--server-connect-function): Add variable for process-dialing
    monitor, a function.
    (erc--server-propagate-failed-connection): Add function to serve as
    default monitor to run on process creation and maybe execute failure
    handlers.
    (erc-server-connect): Run `erc--server-connect-function' for async
    processes one second after creation.
    (erc--server-reconnect-timeout, erc--server-reconnect-timeout-check,
    erc--server-reconnect-timeout-scale-function,
    erc--server-reconnect-timeout-double): Add supporting variables and
    functions for `erc-server-delayed-check-reconnect'.
    (erc-server-delayed-check-reconnect): Add possible alternate value for
    option `erc-server-reconnect-function' that only attempts to reconnect
    after hearing back from the server.
    (erc-schedule-reconnect): Ensure previous `erc-server-process' is
    deleted.
    * test/lisp/erc/erc-scenarios-base-auto-recon.el: New file.
    * test/lisp/erc/resources/base/reconnect/just-eof.eld: New file.
    * test/lisp/erc/resources/base/reconnect/just-ping.eld: New file.
    * test/lisp/erc/resources/base/reconnect/ping-pong.eld: New file.
    * test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld:
    New file.
    * test/lisp/erc/resources/erc-scenarios-common.el
    (erc-scenarios-common--make-bindings): Shadow
    `timer-list'.  (Bug#62044.)
---
 lisp/erc/erc-backend.el                            | 116 ++++++++++++++++-
 test/lisp/erc/erc-scenarios-base-auto-recon.el     | 141 +++++++++++++++++++++
 .../lisp/erc/resources/base/reconnect/just-eof.eld |   3 +
 .../erc/resources/base/reconnect/just-ping.eld     |   4 +
 .../erc/resources/base/reconnect/ping-pong.eld     |   6 +
 .../base/reconnect/unexpected-disconnect.eld       |  24 ++++
 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)