(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.")
(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))))
"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'.
projects / emacs.git / commitdiff