unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 58840@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#58840: 29.0.50; Make scheduled reconnects friendlier in ERC
Date: Fri, 11 Nov 2022 06:07:48 -0800	[thread overview]
Message-ID: <87cz9t4ma3.fsf__15010.6700182491$1668175707$gmane$org@neverwas.me> (raw)
In-Reply-To: <87lep0nkmb.fsf@neverwas.me> (J. P.'s message of "Fri, 28 Oct 2022 06:27:56 -0700")

[-- Attachment #1: Type: text/plain, Size: 123 bytes --]

v2. Added user option to specify function run by reconnect timer.
Factored out reconnect scheduling for use in user code.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 4325 bytes --]

From ce9519f9fa0ecae4dd538d83f12293c238b52c53 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 11 Nov 2022 00:05:00 -0800
Subject: [PATCH 0/1] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (1):
  Improve auto-reconnect visibility in ERC

 lisp/erc/erc-backend.el                       | 77 ++++++++++++++-----
 lisp/erc/erc.el                               | 40 ++++++----
 test/lisp/erc/erc-scenarios-base-reconnect.el | 46 +++++++++++
 3 files changed, 130 insertions(+), 33 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 5f592a2458..bcba2ed40b 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -404,6 +404,16 @@ erc-server-reconnect-timeout
 If a key is pressed while ERC is waiting, it will stop waiting."
   :type 'number)
 
+(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
+  "Function called by the reconnect timer to create a new connection.
+Called with a server buffer as its only argument.  Potential uses
+include exponential backoff and checking for connectivity prior
+to connecting.  Use `erc-schedule-reconnect' to instead defer by
+scheduling another round."
+  :package-version '(ERC . "5.4.1") ; FIXME on next release
+  :type '(choice (function-item erc-server-delayed-reconnect)
+                 function))
+
 (defcustom erc-split-line-length 440
   "The maximum length of a single message.
 If a message exceeds this size, it is broken into multiple ones.
@@ -782,6 +792,22 @@ erc--cancel-auto-reconnect-timer
     (setq erc--server-reconnect-timer nil)
     (erc-update-mode-line)))
 
+(defun erc-schedule-reconnect (buffer &optional incr)
+  "Create and return a reconnect timer for BUFFER.
+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
+                         ?m erc-server-reconnect-timeout
+                         ?n (or count "unlimited")
+                         ?s (if (eql 1 count) "" "s"))
+    (setq erc-server-reconnecting nil
+          erc--server-reconnect-timer
+          (run-at-time erc-server-reconnect-timeout nil
+                       erc-server-reconnect-function buffer))))
+
 (defun erc-process-sentinel-2 (event buffer)
   "Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
   (when (buffer-live-p buffer)
@@ -798,17 +824,7 @@ erc-process-sentinel-2
                                    'terminated ?e event)
               (set-buffer-modified-p nil))
           ;; reconnect
-          (let ((count (and (integerp erc-server-reconnect-attempts)
-                            (- erc-server-reconnect-attempts
-                               (cl-incf erc-server-reconnect-count)))))
-            (erc-display-message nil 'error (current-buffer) 'reconnecting
-                                 ?m erc-server-reconnect-timeout
-                                 ?n (or count "unlimited")
-                                 ?s (if (eql 1 count) "" "s"))
-            (setq erc-server-reconnecting nil
-                  erc--server-reconnect-timer
-                  (run-at-time erc-server-reconnect-timeout nil
-                               #'erc-server-delayed-reconnect buffer))))))
+          (erc-schedule-reconnect buffer))))
     (erc-update-mode-line)))
 
 (defun erc-process-sentinel-1 (event buffer)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0ead2941a2..4c92e4ce0d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6923,7 +6923,7 @@ erc-define-catalog
    (disconnected . "\n\nConnection failed!  Re-establishing connection...\n")
    (disconnected-noreconnect
     . "\n\nConnection failed!  Not re-establishing connection.\n")
-   (reconnecting . "Reconnecting in %ms: %n attempt%s remaining...")
+   (reconnecting . "Reconnecting in %ms: %n additional attempt%s remaining...")
    (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
    (finished . "\n\n*** ERC finished ***\n")
    (terminated . "\n\n*** ERC terminated: %e\n")
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Improve-auto-reconnect-visibility-in-ERC.patch --]
[-- Type: text/x-patch, Size: 14448 bytes --]

From ce9519f9fa0ecae4dd538d83f12293c238b52c53 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 27 Oct 2022 00:21:10 -0700
Subject: [PATCH 1/1] Improve auto-reconnect visibility in ERC

* lisp/erc/erc-backend.el (erc--server-reconnect-timer): New variable.
(erc-server-reconnect-function): New user option.
(erc-process-sentinel-2): Display time remaining until next
reconnection attempt.  Also remove condition case and move bulk of
else condition logic to `erc-schedule-reconnect'.  More importantly,
no longer set `erc--server-reconnecting here').
(erc-server-connect): Initialize `erc--server-reconnect-timer' to nil.
(erc-server-reconnect): Set `erc-server--reconnecting' here.
(erc--mode-line-process-reconnecting): New constant to store value for
"reconnect" state of `mode-line-process'.
(erc--cancel-auto-reconnect-timer): New function to cancel
auto-reconnect timer and print message.
(erc-schedule-reconnect): New function for scheduling another
reconnect attempt.

* lisp/erc/erc.el (erc-open): Only update mode line for target
buffers. For server buffers, let `erc-login' and/or process sentinels
take care of it.
(erc-cmd-RECONNECT): Cancel existing auto-reconnect
timer, if any, before proceeding.  Defer to `erc-server-reconnect' to set
`erc--server-reconnecting'.  Fix `with-suppressed-warnings' form.
(erc-cmd-RMRECONNS, erc-cmd-RMRECONN): Add new slash commands based on
Irssi namesake.
(erc-update-mode-line-buffer): Show "reconnecting in Ns" for
`mode-line-process' when awaiting an automatic reconnect attempt.
(erc-message-english-reconnecting,
erc-message-english-reconnect-canceled): Add new message functions to
English catalog.

* lisp/erc/erc-scenarios-base-reconnect
(erc-scenarios-base-cancel-reconnect): Add new test case for canceling
reconnect timers.
---
 lisp/erc/erc-backend.el                       | 77 ++++++++++++++-----
 lisp/erc/erc.el                               | 40 ++++++----
 test/lisp/erc/erc-scenarios-base-reconnect.el | 46 +++++++++++
 3 files changed, 130 insertions(+), 33 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 026b34849a..bcba2ed40b 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -299,6 +299,9 @@ erc-server-reconnect-count
 (defvar-local erc--server-last-reconnect-count 0
   "Snapshot of reconnect count when the connection was established.")
 
+(defvar-local erc--server-reconnect-timer nil
+  "Auto-reconnect timer for a network context.")
+
 (defvar-local erc-server-quitting nil
   "Non-nil if the user requests a quit.")
 
@@ -401,6 +404,16 @@ erc-server-reconnect-timeout
 If a key is pressed while ERC is waiting, it will stop waiting."
   :type 'number)
 
+(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
+  "Function called by the reconnect timer to create a new connection.
+Called with a server buffer as its only argument.  Potential uses
+include exponential backoff and checking for connectivity prior
+to connecting.  Use `erc-schedule-reconnect' to instead defer by
+scheduling another round."
+  :package-version '(ERC . "5.4.1") ; FIXME on next release
+  :type '(choice (function-item erc-server-delayed-reconnect)
+                 function))
+
 (defcustom erc-split-line-length 440
   "The maximum length of a single message.
 If a message exceeds this size, it is broken into multiple ones.
@@ -645,7 +658,8 @@ erc-server-connect
       (setq erc-server-process process)
       (setq erc-server-quitting nil)
       (setq erc-server-reconnecting nil
-            erc--server-reconnecting nil)
+            erc--server-reconnecting nil
+            erc--server-reconnect-timer nil)
       (setq erc-server-timed-out nil)
       (setq erc-server-banned nil)
       (setq erc-server-error-occurred nil)
@@ -686,6 +700,7 @@ erc-server-reconnect
     (with-current-buffer buffer
       (erc-update-mode-line)
       (erc-set-active-buffer (current-buffer))
+      (setq erc--server-reconnecting t)
       (setq erc-server-last-sent-time 0)
       (setq erc-server-lines-sent 0)
       (let ((erc-server-connect-function (or erc-session-connector
@@ -758,37 +773,59 @@ erc-server-reconnect-p
         erc-server-reconnecting)
       (erc--server-reconnect-p event)))
 
+(defconst erc--mode-line-process-reconnecting
+  '(:eval (erc-with-server-buffer
+            (and erc--server-reconnect-timer
+                 (format ": reconnecting in %.1fs"
+                         (- (timer-until erc--server-reconnect-timer
+                                         (current-time)))))))
+  "Mode-line construct showing seconds until next reconnect attempt.
+Move point around to refresh.")
+
+(defun erc--cancel-auto-reconnect-timer ()
+  (when erc--server-reconnect-timer
+    (cancel-timer erc--server-reconnect-timer)
+    (erc-display-message nil 'notice nil 'reconnect-canceled
+                         ?u (buffer-name)
+                         ?c (- (timer-until erc--server-reconnect-timer
+                                            (current-time))))
+    (setq erc--server-reconnect-timer nil)
+    (erc-update-mode-line)))
+
+(defun erc-schedule-reconnect (buffer &optional incr)
+  "Create and return a reconnect timer for BUFFER.
+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
+                         ?m erc-server-reconnect-timeout
+                         ?n (or count "unlimited")
+                         ?s (if (eql 1 count) "" "s"))
+    (setq erc-server-reconnecting nil
+          erc--server-reconnect-timer
+          (run-at-time erc-server-reconnect-timeout nil
+                       erc-server-reconnect-function buffer))))
+
 (defun erc-process-sentinel-2 (event buffer)
   "Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
-  (if (not (buffer-live-p buffer))
-      (erc-update-mode-line)
+  (when (buffer-live-p buffer)
     (with-current-buffer buffer
-      (let ((reconnect-p (erc--server-reconnect-p event)) message delay)
+      (let ((reconnect-p (erc--server-reconnect-p event)) message)
         (setq message (if reconnect-p 'disconnected 'disconnected-noreconnect))
         (erc-display-message nil 'error (current-buffer) message)
         (if (not reconnect-p)
             ;; terminate, do not reconnect
             (progn
-              (setq erc--server-reconnecting nil)
+              (setq erc--server-reconnecting nil
+                    erc--server-reconnect-timer nil)
               (erc-display-message nil 'error (current-buffer)
                                    'terminated ?e event)
-              ;; Update mode line indicators
-              (erc-update-mode-line)
               (set-buffer-modified-p nil))
           ;; reconnect
-          (condition-case nil
-              (progn
-                (setq erc-server-reconnecting nil
-                      erc--server-reconnecting t
-                      erc-server-reconnect-count (1+ erc-server-reconnect-count))
-                (setq delay erc-server-reconnect-timeout)
-                (run-at-time delay nil
-                             #'erc-server-delayed-reconnect buffer))
-            (error (unless (integerp erc-server-reconnect-attempts)
-                     (message "%s ... %s"
-                              "Reconnecting until we succeed"
-                              "kill the ERC server buffer to stop"))
-                   (erc-server-delayed-reconnect buffer))))))))
+          (erc-schedule-reconnect buffer))))
+    (erc-update-mode-line)))
 
 (defun erc-process-sentinel-1 (event buffer)
   "Called when `erc-process-sentinel' has decided that we're disconnecting.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6b14cf87e2..4c92e4ce0d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2032,12 +2032,12 @@ erc-open
     ;; Saving log file on exit
     (run-hook-with-args 'erc-connect-pre-hook buffer)
 
-    (when connect
-      (erc-server-connect erc-session-server
-                          erc-session-port
-                          buffer
-                          erc-session-client-certificate))
-    (erc-update-mode-line)
+    (if connect
+        (erc-server-connect erc-session-server
+                            erc-session-port
+                            buffer
+                            erc-session-client-certificate)
+      (erc-update-mode-line))
 
     ;; Now display the buffer in a window as per user wishes.
     (unless (eq buffer old-buffer)
@@ -3809,10 +3809,11 @@ erc-cmd-RECONNECT
     (unless (buffer-live-p buffer)
       (setq buffer (current-buffer)))
     (with-current-buffer buffer
+      (when erc--server-reconnect-timer
+        (erc--cancel-auto-reconnect-timer))
       (setq erc-server-quitting nil)
       (with-suppressed-warnings ((obsolete erc-server-reconnecting))
         (setq erc-server-reconnecting t))
-      (setq erc--server-reconnecting t)
       (setq erc-server-reconnect-count 0)
       (setq process (get-buffer-process (erc-server-buffer)))
       (when process
@@ -3828,6 +3829,16 @@ erc-cmd-RECONNECT
   t)
 (put 'erc-cmd-RECONNECT 'process-not-needed t)
 
+(defun erc-cmd-RMRECONNS ()
+  "Cancel all auto-reconnect timers."
+  (erc-buffer-filter #'erc--cancel-auto-reconnect-timer)
+  t)
+
+(defun erc-cmd-RMRECONN ()
+  "Cancel auto-reconnect timer for current connection."
+  (erc-with-server-buffer (erc--cancel-auto-reconnect-timer))
+  t)
+
 (defun erc-cmd-SERVER (server)
   "Connect to SERVER, leaving existing connection intact."
   (erc-log (format "cmd: SERVER: %s" server))
@@ -6711,11 +6722,12 @@ erc-update-mode-line-buffer
                   (?s . ,(erc-format-target-and/or-server))
                   (?S . ,(erc-format-target-and/or-network))
                   (?t . ,(erc-format-target))))
-          (process-status (cond ((and (erc-server-process-alive)
-                                      (not erc-server-connected))
-                                 ":connecting")
-                                ((erc-server-process-alive)
-                                 "")
+          (process-status (cond ((erc-server-process-alive buffer)
+                                 (unless erc-server-connected
+                                   ": connecting"))
+                                ((erc-with-server-buffer
+                                   erc--server-reconnect-timer)
+                                 erc--mode-line-process-reconnecting)
                                 (t
                                  ": CLOSED")))
           (face (cond ((eq erc-header-line-face-method nil)
@@ -6726,7 +6738,7 @@ erc-update-mode-line-buffer
                        'erc-header-line))))
       (setq mode-line-buffer-identification
             (list (format-spec erc-mode-line-format spec)))
-      (setq mode-line-process (list process-status))
+      (setq mode-line-process process-status)
       (let ((header (if erc-header-line-format
                         (format-spec erc-header-line-format spec)
                       nil)))
@@ -6911,6 +6923,8 @@ erc-define-catalog
    (disconnected . "\n\nConnection failed!  Re-establishing connection...\n")
    (disconnected-noreconnect
     . "\n\nConnection failed!  Not re-establishing connection.\n")
+   (reconnecting . "Reconnecting in %ms: %n additional attempt%s remaining...")
+   (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
    (finished . "\n\n*** ERC finished ***\n")
    (terminated . "\n\n*** ERC terminated: %e\n")
    (login . "Logging in as `%n'...")
diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el b/test/lisp/erc/erc-scenarios-base-reconnect.el
index 49298dc594..466b087676 100644
--- a/test/lisp/erc/erc-scenarios-base-reconnect.el
+++ b/test/lisp/erc/erc-scenarios-base-reconnect.el
@@ -224,4 +224,50 @@ erc-scenarios-base-association-reconnect-playback
       (with-current-buffer "#chan"
         (funcall expect 10 "here comes the lady")))))
 
+
+(ert-deftest erc-scenarios-base-cancel-reconnect ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/reconnect")
+       (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last))
+       (port (process-contact dumb-server :service))
+       (expect (erc-d-t-make-expecter))
+       (erc-server-auto-reconnect t)
+       erc-autojoin-channels-alist
+       erc-server-buffer)
+
+    (ert-info ("Connect to foonet")
+      (setq erc-server-buffer (erc :server "127.0.0.1"
+                                   :port port
+                                   :nick "tester"
+                                   :password "changeme"
+                                   :full-name "tester"))
+      (with-current-buffer erc-server-buffer
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+    (ert-info ("Two connection attempts, all stymied")
+      (with-current-buffer erc-server-buffer
+        (ert-info ("First two attempts behave normally")
+          (dotimes (n 2)
+            (ert-info ((format "Initial attempt %d" (1+ n)))
+              (funcall expect 3 "Opening connection")
+              (funcall expect 2 "Password incorrect")
+              (funcall expect 2 "Connection failed!")
+              (funcall expect 2 "Re-establishing connection"))))
+        (ert-info ("/RECONNECT cancels timer but still attempts to connect")
+          (erc-cmd-RECONNECT)
+          (funcall expect 2 "Canceled")
+          (funcall expect 3 "Opening connection")
+          (funcall expect 2 "Password incorrect")
+          (funcall expect 2 "Connection failed!")
+          (funcall expect 2 "Re-establishing connection"))
+        (ert-info ("Explicit /RMRECONN simply cancels timer")
+          (erc-cmd-RMRECONN)
+          (funcall expect 2 "Canceled")
+          (erc-d-t-absent-for 1 "Opening connection" (point)))))
+
+    (ert-info ("Server buffer is unique and temp name is absent")
+      (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
+                     (erc-scenarios-common-buflist "127.0.0.1"))))))
+
 ;;; erc-scenarios-base-reconnect.el ends here
-- 
2.38.1


       reply	other threads:[~2022-11-11 14:07 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <87lep0nkmb.fsf@neverwas.me>
2022-11-11 14:07 ` J.P. [this message]
     [not found] ` <87cz9t4ma3.fsf@neverwas.me>
2022-11-13  4:11   ` bug#58840: 29.0.50; Make scheduled reconnects friendlier in ERC Stefan Kangas
     [not found]   ` <CADwFkmmL7-=R5pED-omQmi04Up9CJRHM92086Tmv3HFSk0JWqw@mail.gmail.com>
2022-11-13 15:31     ` J.P.
2022-10-28 13:27 J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='87cz9t4ma3.fsf__15010.6700182491$1668175707$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=58840@debbugs.gnu.org \
    --cc=emacs-erc@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).