master 331bcfaee51 2/2: Reuse client cert for connectivity probing in ERC

[F. Jason Park]

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

    Reuse client cert for connectivity probing in ERC
    
    * lisp/erc/erc-backend.el (erc--server-connect-function)
    (erc--server-post-dial-function): Rename former to latter because the
    existing name is better suited for the eventual generalizing of
    `erc-server-connect' in a future version.
    (erc-server-connect): Use new name for `erc--server-connect-function',
    `erc--server-post-dial-function'.
    (erc--recon-probe-reschedule, erc--recon-probe-sentinel)
    (erc--recon-probe-filter, erc--recon-probe-check): New functions
    factored out of `erc-server-delayed-check-reconnect'.
    (erc-server-delayed-check-reconnect): Refactor, splitting off lambdas
    into top-level functions for improved tracing.
    * lisp/erc/erc.el (erc-message-english-recon-probe-hung-up)
    (erc-message-english-recon-probe-nobody-home): New
    variables.  (Bug#62044)
    
    Thanks to Libera.Chat user arjan for reporting this bug, which
    is new in ERC 5.6 and Emacs 30.1.
---
 lisp/erc/erc-backend.el | 193 +++++++++++++++++++++++++++++-------------------
 lisp/erc/erc.el         |   2 +
 2 files changed, 119 insertions(+), 76 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 84c22d840fb..713547a591a 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -716,7 +716,8 @@ 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
+(defvar erc--server-post-dial-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.")
@@ -795,7 +796,7 @@ TLS (see `erc-session-client-certificate' for more 
details)."
         (let ((erc--msg-prop-overrides `((erc--skip . (stamp))
                                          ,@erc--msg-prop-overrides)))
           (erc-display-message nil nil buffer "Opening connection..\n")
-          (run-at-time 1 nil erc--server-connect-function process))
+          (run-at-time 1 nil erc--server-post-dial-function process))
       (message "%s...done" msg)
       (erc--register-connection))))
 
@@ -846,89 +847,129 @@ Make sure you are in an ERC buffer when running this."
   "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--recon-probe-reschedule (proc)
+  "Print a message saying PROC's intended peer can't be reached.
+Then call `erc-schedule-reconnect'."
+  (let ((buffer (process-buffer proc)))
+    (when (buffer-live-p buffer)
+      (with-current-buffer buffer
+        (let ((erc-server-reconnect-timeout erc--server-reconnect-timeout))
+          ;; FIXME either remove this deletion or explain why the one
+          ;; performed by `erc-schedule-reconnect' is insufficient.
+          ;; Perhaps because `proc' may not equal `erc-server-process'?
+          (when proc ; conn refused w/o :nowait
+            (delete-process proc))
+          (erc-display-message nil '(notice error) buffer
+                               'recon-probe-nobody-home)
+          (erc-schedule-reconnect buffer 0))))))
+
+(defun erc--recon-probe-sentinel (proc event)
+  "Send a \"PING\" to PROC's peer on an \"open\" EVENT.
+Otherwise, try connecting from scratch again after timeout."
+  (pcase event
+    ("open\n"
+     (let ((cookie (time-convert nil 'integer)))
+       (process-put proc 'erc--reconnect-cookie cookie)
+       ;; FIXME account for possible `file-error' when sending.
+       (run-at-time nil nil #'process-send-string proc
+                    (format "PING %d\r\n" cookie))))
+    ((and "connection broken by remote peer\n"
+          (guard (process-get proc 'erc--reconnect-cookie))
+          (let buffer (process-buffer proc))
+          (guard (buffer-live-p buffer)))
+     ;; This can run, for example, if the client dials a TLS-terminating
+     ;; endpoint with a non-TLS opener, like `erc-open-tls-stream', or
+     ;; if the server doesn't take kindly to an opening "PING" during
+     ;; connection registration.
+     (with-current-buffer buffer
+       (delete-process proc)
+       ;; Undo latest penalizing timeout increment.
+       (setq erc--server-reconnect-timeout
+             (max 1 (/ erc--server-reconnect-timeout 2)))
+       (erc-display-message nil '(notice error) buffer 'recon-probe-hung-up
+                            ?t erc--server-reconnect-timeout)
+       (run-at-time erc--server-reconnect-timeout
+                    nil #'erc-server-delayed-reconnect buffer)))
+    ((or "connection broken by remote peer\n" (rx bot "failed"))
+     (run-at-time nil nil #'erc--recon-probe-reschedule proc))))
+
+(defun erc--recon-probe-filter (proc string)
+  "Reconnect, reusing PROC if STRING contains a \"PONG\"."
+  (when-let* ((buffer (process-buffer proc))
+              (buffer-live-p buffer))
+    (with-current-buffer buffer
+      (setq erc--server-reconnect-timeout nil))
+    (if-let* ; reuse proc if string has complete message
+        ((cookie (process-get proc 'erc--reconnect-cookie))
+         ;; Accommodate a leading ":<source> ".
+         ((string-suffix-p (format "PONG %d\r\n" cookie) string)))
+        (progn
+          (erc-log-irc-protocol string nil)
+          (set-process-sentinel proc #'ignore)
+          (set-process-filter proc nil)
+          (run-at-time nil nil #'erc-server--reconnect-opened buffer proc))
+      (delete-process proc)
+      (run-at-time nil nil #'erc-server-delayed-reconnect buffer))))
+
+(defun erc--recon-probe-check (proc tmrx)
+  "Restart auto-reconnect probe if PROC has failed or TIMER has EXPIRE'd.
+Expect TMRX to be a cons cell of (EXPIRE . TIMER)."
+  (let* ((status (process-status proc))
+         (expiredp (time-less-p (pop tmrx) (current-time)))
+         (buffer (process-buffer proc)))
+    (when (or expiredp
+              (not (eq 'connect status)) ; e.g., `closed'
+              (not (buffer-live-p buffer)))
+      (cancel-timer tmrx))
+    (cond ((not (buffer-live-p buffer)))
+          (expiredp
+           (erc-display-message nil 'error buffer "Timed out while dialing...")
+           (delete-process proc)
+           (erc--recon-probe-reschedule proc))
+          ((eq 'failed status)
+           (erc--recon-probe-reschedule proc)))))
+
+;; This probing strategy may appear to hang at various junctures.  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.
 Use server BUFFER's cached session info to reestablish the logical
-connection at the IRC protocol level.  Do this by probing for a
-successful response to a PING before commencing with \"connection
-registration\".  Do not distinguish between configuration problems and
-the absence of service.  For example, expect users of proxy-based
-connectors, like `erc-open-socks-tls-stream', to ensure their setup
-works before choosing this function as their reconnector."
+connection at the IRC protocol level.  Do this by probing for any
+response to a PING, including a hang up, before (possibly) dialing again
+and commencing with \"connection registration\".  Make no distinction
+between configuration issues and the absence of service in printed
+feedback.  For example, expect users of proxy-based connectors, like
+`erc-open-socks-tls-stream', to ensure their setup works before choosing
+this function as their reconnector."
   (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))
-                                 (when proc ; conn refused w/o :nowait
-                                   (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 xprdp (not (eq 'connect status)))
-                           (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"
-                            (let ((cookie (time-convert nil 'integer)))
-                              (process-put proc 'erc--reconnect-cookie cookie)
-                              (run-at-time nil nil #'process-send-string proc
-                                           (format "PING %d\r\n" cookie))))
-                           ((or "connection broken by remote peer\n"
-                                (rx bot "failed"))
-                            (run-at-time nil nil reschedule proc)))))
-             (filter (lambda (proc string)
-                       (with-current-buffer buffer
-                         (setq erc--server-reconnect-timeout nil))
-                       (if-let* ; reuse proc if string has complete message
-                           ((cookie (process-get proc 'erc--reconnect-cookie))
-                            ((string-suffix-p (format "PONG %d\r\n" cookie)
-                                              string))) ; leading ":<source> "
-                           (progn
-                             (erc-log-irc-protocol string nil)
-                             (set-process-sentinel proc #'ignore)
-                             (set-process-filter proc nil)
-                             (run-at-time nil nil
-                                          #'erc-server--reconnect-opened
-                                          buffer proc))
-                         (delete-process proc)
-                         (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)))
-              (setq conchk-timer (run-at-time 1 1 conchk proc))
-              (set-process-filter proc filter)
-              (set-process-sentinel proc sentinel)
-              (when (eq (process-status proc) 'open) ; :nowait is nil
-                (funcall sentinel proc "open\n")))
-          ;; E.g., "make client process failed" "Connection refused".
-          (file-error (funcall reschedule nil)))))))
+      (condition-case _
+          (let* ((cert erc-session-client-certificate)
+                 (tmrx (list (time-add erc--server-reconnect-timeout-check
+                                       (current-time))))
+                 (server (if (string-match erc--server-connect-dumb-ipv6-regexp
+                                           erc-session-server)
+                             (match-string 1 erc-session-server)
+                           erc-session-server))
+                 (proc (apply erc-session-connector "*erc-connectivity-check*"
+                              nil server erc-session-port
+                              (and cert (list :client-certificate cert)))))
+            (setcdr tmrx (run-at-time 1 1 #'erc--recon-probe-check proc tmrx))
+            (set-process-filter proc #'erc--recon-probe-filter)
+            (set-process-sentinel proc #'erc--recon-probe-sentinel)
+            (set-process-buffer proc buffer)
+            ;; Should `erc-server-process' also be set to `proc' here so
+            ;; that `erc-schedule-reconnect' can use it?
+            (cl-assert (processp proc))
+            (when (eq (process-status proc) 'open) ; :nowait is nil
+              (erc--recon-probe-sentinel proc "open\n")))
+        ;; E.g., "make client process failed" "Connection refused".
+        (file-error (erc--recon-probe-reschedule nil))))))
 
 (defun erc-server-prefer-check-reconnect (buffer)
   "Defer to another reconnector based on BUFFER's `erc-session-connector'.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 28ccb5809a7..72335a444cb 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -9572,6 +9572,8 @@ SOFTP, only do so when defined as a variable."
    (ignore-list . "%-8p %s")
    (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
    (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
+   (recon-probe-hung-up . "Server answered but hung up. Delaying by %ts...")
+   (recon-probe-nobody-home . "Nobody home...")
    (finished . "\n\n*** ERC finished ***\n")
    (terminated . "\n\n*** ERC terminated: %e\n")
    (login . "Logging in as `%n'...")