feature/rcirc-update 8eb9eb0 3/7: Allow for multiple attempts when reconnecting

[Philip Kaludercic]

branch: feature/rcirc-update
commit 8eb9eb0c41417991432122795522f6db7e1bb7d2
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Allow for multiple attempts when reconnecting
    
    * doc/misc/rcirc.texi (rcirc commands): Mention rcirc-reconnect-attempts
    * etc/NEWS: Document change
    (rcirc-connect): Ensure no other process exists
    (rcirc-reconnect-attempts): Add option
    (rcirc-failed-attempts): Add local variable
    (rcirc-reconnection-timer): Add local variable
    (rcirc-reconnect): Add function
    (rcirc-sentinel): Manage multiple reconnection attempts
    (rcirc-process-server-response): Change user for error messages
    (rcirc-mode): Don't set rcirc-last-connect-time
    (reconnect): Extract functionality to rcirc-reconnect
---
 doc/misc/rcirc.texi |   8 ++-
 etc/NEWS            |   6 +-
 lisp/net/rcirc.el   | 184 +++++++++++++++++++++++++++++++++-------------------
 3 files changed, 130 insertions(+), 68 deletions(-)

diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index fb90d84..47de523 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -430,7 +430,13 @@ lost.  The simple solution is to use @kbd{M-x rcirc}.  The 
problem is
 that this opens an @emph{additional} connection, so you'll have two
 copies of every channel buffer, one dead and one live.
 
-The real answer, therefore, is the @code{/reconnect} command.
+One option therefore, is the @code{/reconnect} command.
+
+An other approach is to set @code{rcirc-reconnect-delay} to a value
+greater than 0, and allow rcirc to reconnect when it detects that the
+connection has been closed.  By default it will try to do this three
+times (as specified by @code{rcirc-reconnect-attempts}), before giving
+up.
 @end table
 
 @node Useful IRC commands
diff --git a/etc/NEWS b/etc/NEWS
index ed39a4b..8f30a32 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2699,7 +2699,7 @@ The function now accepts a variable number of arguments.
 
 +++
 *** Deprecate defun-rcirc-command in favour of rcirc-define-command
-The new macro handles 
+The new macro handles multiple and optional arguments.
 
 ---
 *** Add basic IRCv3 support
@@ -2719,6 +2719,10 @@ message-ids, invite-notify, multi-prefix and 
standard-replies.
 *** Allow for channels to hide certain message types right after connecting.
 Set rcirc-omit-responses-after-join analogously to rcirc-omit-responses.
 
++++
+*** Implement repeated reconnection strategy
+See rcirc-reconnect-attempts.
+
 ** Miscellaneous
 
 ---
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index a3c427a..6c66956 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -601,6 +601,8 @@ FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION 
SERVER-ALIAS).
 See `rcirc-connect' for more details on these variables.")
 (defvar-local rcirc-process nil
   "Network process for the current connection.")
+(defvar-local rcirc-last-connect-time nil
+  "The last time the buffer was connected.")
 
 ;;; IRCv3 capability negotiation 
(https://ircv3.net/specs/extensions/capability-negotiation)
 (defvar rcirc-implemented-capabilities
@@ -669,11 +671,18 @@ that are joined after authentication."
            (full-name (or full-name rcirc-default-full-name))
            (startup-channels startup-channels)
 
-           (process (open-network-stream
+           process)
+
+      ;; Ensure any previous process is killed
+      (when-let ((old-process (get-process (or server-alias server))))
+        (set-process-sentinel old-process #'ignore)
+        (delete-process process))
+
+      ;; Set up process
+      (setq process (open-network-stream
                      (or server-alias server) nil server port-number
                      :type (or encryption 'plain)
-                     :nowait t)))
-      ;; set up process
+                     :nowait t))
       (set-process-coding-system process 'raw-text 'raw-text)
       (with-current-buffer (get-buffer-create (rcirc-generate-new-buffer-name 
process nil))
         (set-process-buffer process (current-buffer))
@@ -692,9 +701,17 @@ that are joined after authentication."
         (setq rcirc-nick nick)
         (setq rcirc-startup-channels startup-channels)
         (setq rcirc-last-server-message-time (current-time))
-
-        (setq mode-line-process ":connecting")
-        (setq rcirc-connecting t)
+        (setq rcirc-last-connect-time (current-time))
+
+        ;; Check if the immediate process state
+        (sit-for .1)
+        (cond
+         ((eq (process-status process) 'failed)
+          (setq mode-line-process ":disconnected")
+          (setq rcirc-connecting nil))
+         ((eq (process-status process) 'connect)
+          (setq mode-line-process ":connecting")
+          (setq rcirc-connecting t)))
 
         (add-hook 'auto-save-hook #'rcirc-log-write)
 
@@ -788,66 +805,110 @@ When 0, do not auto-reconnect."
   :version "25.1"
   :type 'integer)
 
-(defvar-local rcirc-last-connect-time nil
-  "The last time the buffer was connected.")
+(defcustom rcirc-reconnect-attempts 3
+  "Number of times a reconnection should be attempted."
+  :version "28.1"
+  :type 'integer)
+
+(defvar-local rcirc-failed-attempts 0
+  "Number of times reconnecting has failed.")
+
+(defvar-local rcirc-reconnection-timer nil
+  "Timer used for reconnecting.")
+
+(defun rcirc-reconnect (process &optional quiet)
+  "Attempt to reconnect connection to PROCESS.
+If QUIET is non-nil, no not emit a message."
+  (with-rcirc-process-buffer process
+    (catch 'exit
+      (if (rcirc--connection-open-p process)
+          (throw 'exit (or quiet (message "Server process is alive")))
+        (delete-process process))
+      (let ((conn-info rcirc-connection-info))
+       (setf (nth 5 conn-info)
+             (cl-remove-if-not #'rcirc-channel-p
+                               (mapcar #'car rcirc-buffer-alist)))
+        (dolist (buffer (mapcar #'cdr rcirc-buffer-alist))
+         (when (buffer-live-p buffer)
+            (with-current-buffer buffer
+             (setq mode-line-process ":connecting"))))
+       (let ((nprocess (apply #'rcirc-connect conn-info)))
+          (when (and (< rcirc-failed-attempts rcirc-reconnect-attempts)
+                     (eq (process-status nprocess) 'failed))
+            (setq rcirc-failed-attempts (1+ rcirc-failed-attempts))
+            (rcirc-print nprocess "*rcirc*" "ERROR" nil
+                        (format "Failed to reconnect (%d/%d)..."
+                                 rcirc-failed-attempts
+                                 rcirc-reconnect-attempts))
+            (setq rcirc-reconnection-timer
+                  (run-at-time rcirc-timeout-seconds nil
+                               #'rcirc-reconnect process t))))))))
 
 (defun rcirc-sentinel (process sentinel)
   "Called when PROCESS receives SENTINEL."
   (let ((sentinel (string-replace "\n" "" sentinel)))
     (rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
     (with-rcirc-process-buffer process
-      (if (string= sentinel "open")
-          (let* ((server (nth 0 rcirc-connection-info))
-                 (user-name (nth 3 rcirc-connection-info))
-                 (full-name (nth 4 rcirc-connection-info))
-                 (password (nth 6 rcirc-connection-info))
-                 (server-alias (nth 8 rcirc-connection-info))
-                 (use-sasl (eq (rcirc-get-server-method server) 'sasl)))
-
-            ;; prepare SASL authentication
-            (when use-sasl
-              (rcirc-send-string process "CAP REQ sasl")
-              (setq-local rcirc-finished-sasl nil))
-
-            ;; identify
-            (dolist (cap rcirc-implemented-capabilities)
-              (rcirc-send-string process "CAP" "REQ" : cap)
-              (push cap rcirc-requested-capabilities))
-            (unless (zerop (length password))
-              (rcirc-send-string process "PASS" password))
-            (rcirc-send-string process "NICK" rcirc-nick)
-            (rcirc-send-string process "USER" user-name "0" "*" : full-name)
-
-            ;; Setup sasl, and initiate authentication.
-            (when (and rcirc-auto-authenticate-flag
-                       use-sasl)
-              (rcirc-send-string process "AUTHENTICATE" "PLAIN"))
-
-            ;; setup ping timer if necessary
-            (unless rcirc-keepalive-timer
-              (setq rcirc-keepalive-timer
-                    (run-at-time 0 (/ rcirc-timeout-seconds 2) 
#'rcirc-keepalive)))
-
-            (message "Connecting to %s...done" (or server-alias server))
-            (setq mode-line-process nil))
-        (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
+      (cond
+       ((string= sentinel "open")
+        (let* ((server (nth 0 rcirc-connection-info))
+               (user-name (nth 3 rcirc-connection-info))
+               (full-name (nth 4 rcirc-connection-info))
+               (password (nth 6 rcirc-connection-info))
+               (server-alias (nth 8 rcirc-connection-info))
+               (use-sasl (eq (rcirc-get-server-method server) 'sasl)))
+
+          ;; Prepare SASL authentication
+          (when use-sasl
+            (rcirc-send-string process "CAP REQ sasl")
+            (setq-local rcirc-finished-sasl nil))
+
+          ;; Capability negotiation
+          (dolist (cap rcirc-implemented-capabilities)
+            (rcirc-send-string process "CAP" "REQ" : cap)
+            (push cap rcirc-requested-capabilities))
+
+          ;; Identify user
+          (unless (zerop (length password))
+            (rcirc-send-string process "PASS" password))
+          (rcirc-send-string process "NICK" rcirc-nick)
+          (rcirc-send-string process "USER" user-name "0" "*" : full-name)
+
+          ;; Setup sasl, and initiate authentication.
+          (when (and rcirc-auto-authenticate-flag
+                     use-sasl)
+            (rcirc-send-string process "AUTHENTICATE" "PLAIN"))
+
+          ;; Setup ping timer if necessary
+          (unless rcirc-keepalive-timer
+            (setq rcirc-keepalive-timer
+                  (run-at-time 0 (/ rcirc-timeout-seconds 2) 
#'rcirc-keepalive)))
+
+          ;; Reset previous reconnection attempts
+          (setq rcirc-failed-attempts 0)
+          (when rcirc-reconnection-timer
+            (cancel-timer rcirc-reconnection-timer)
+            (setq rcirc-reconnection-timer nil))
+
+          (message "Connecting to %s...done" (or server-alias server))
+          (setq mode-line-process nil)))
+       ((string= sentinel "deleted")
+        (let ((now (current-time)))
+          (with-rcirc-process-buffer process
+            (when (and (< 0 rcirc-reconnect-delay)
+                       (time-less-p rcirc-reconnect-delay
+                                   (time-subtract now 
rcirc-last-connect-time)))
+              (setq rcirc-last-connect-time now)
+              (rcirc-reconnect process)))))
+       ((dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
          (with-current-buffer (or buffer (current-buffer))
-           (rcirc-print process "rcirc.el" "ERROR" rcirc-target
+           (rcirc-print process "*rcirc*" "ERROR" rcirc-target
                         (format "%s: %s (%S)"
                                 (process-name process)
                                 sentinel
                                 (process-status process))
                          (not rcirc-target))
-           (rcirc-disconnect-buffer)))
-        (when (and (string= sentinel "deleted")
-                   (< 0 rcirc-reconnect-delay)
-                   (not rcirc-connecting))
-          (let ((now (current-time)))
-            (when (or (null rcirc-last-connect-time)
-                     (time-less-p rcirc-reconnect-delay
-                                  (time-subtract now rcirc-last-connect-time)))
-              (setq rcirc-last-connect-time now)
-              (rcirc-cmd-reconnect nil)))))
+           (rcirc-disconnect-buffer)))))
       (run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
 
 (defun rcirc-disconnect-buffer (&optional buffer)
@@ -907,7 +968,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and 
LINE.")
       (condition-case err
           (rcirc-process-server-response-1 process text)
         (error
-         (rcirc-print process "RCIRC" "ERROR" nil
+         (rcirc-print process "*rcirc*" "ERROR" nil
                       (format "\"%s\" %s" text err) t)))
     (rcirc-process-server-response-1 process text)))
 
@@ -1310,7 +1371,6 @@ PROCESS is the process object used for communication.
   (setq rcirc-last-post-time (current-time))
   (setq-local fill-paragraph-function 'rcirc-fill-paragraph)
   (setq rcirc-current-line 0)
-  (setq rcirc-last-connect-time (current-time))
 
   (use-hard-newlines t)
 
@@ -2579,16 +2639,8 @@ to `rcirc-default-part-reason'."
 (rcirc-define-command reconnect ()
   "Reconnect to current server."
   (interactive "i")
-  (with-rcirc-server-buffer
-    (catch 'exit
-      (if (eq (process-status process) 'open)
-          (throw 'exit (message "Server process is alive"))
-        (delete-process process))
-      (let ((conn-info rcirc-connection-info))
-       (setf (nth 5 conn-info)
-             (cl-remove-if-not #'rcirc-channel-p
-                               (mapcar #'car rcirc-buffer-alist)))
-       (apply #'rcirc-connect conn-info)))))
+  (setq rcirc-failed-attempts 0)
+  (rcirc-reconnect process))
 
 (rcirc-define-command nick (nick)
   "Change nick to NICK."