Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Add probing erc-server-reconnect-function variant

Browse source 
* 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.)
This commit is contained in:
F. Jason Park 2023-03-08 06:14:36 -08:00
parent 4da7d24988
commit 03eddc9924
7 changed files with 290 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

116
lisp/erc/erc-backend.el
View file

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

141
test/lisp/erc/erc-scenarios-base-auto-recon.el Normal file
View file

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

3
test/lisp/erc/resources/base/reconnect/just-eof.eld Normal file
View file

@ -0,0 +1,3 @@
;; -*- mode: lisp-data; -*-
((eof 5 EOF))
((drop 0 DROP))

4
test/lisp/erc/resources/base/reconnect/just-ping.eld Normal file
View file

@ -0,0 +1,4 @@
;; -*- mode: lisp-data; -*-
((ping 20 "PING"))
((eof 10 EOF))

6
test/lisp/erc/resources/base/reconnect/ping-pong.eld Normal file
View file

@ -0,0 +1,6 @@
;; -*- mode: lisp-data; -*-
((ping 10 "PING ")
(0 "PONG fake"))
((eof 10 EOF))
((drop 0 DROP))

24
test/lisp/erc/resources/base/reconnect/unexpected-disconnect.eld Normal file
View file

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

1
test/lisp/erc/resources/erc-scenarios-common.el
View file

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