improved reconnect to compensate for ARM wake times

This commit is contained in:
David Botton 2024-06-28 11:28:03 -04:00
parent 5dba6315ac
commit a894c739c8
3 changed files with 58 additions and 41 deletions

View file

@ -41,42 +41,46 @@
"Handle new incoming websocket CONNECTIONS with ID from boot page. (Private)" "Handle new incoming websocket CONNECTIONS with ID from boot page. (Private)"
(handler-case (handler-case
(cond ((and id (gethash id *connection-data*)) (cond ((and id (gethash id *connection-data*))
(format t "Reconnection id - ~A to ~A~%" id connection) (format t "Reconnection id - ~A to ~A~%" id connection)
(handler-case (let ((old (gethash id *connection-ids*)))
(websocket-driver:close-connection (gethash id *connection-ids*) (when *verbose-output*
"Aborting this old connection since receiving a reconnection request.") (format t "Transfer id - ~A => ~A" old connection))
(t (c) (setf (gethash old *connections*) nil)
(when *verbose-output* (setf (gethash connection *connections*) id)
(format t "Failed to close the old connection when establishing reconnection. ~ (setf (gethash id *connection-ids*) connection)
This can be normal: The old connection could not work for the client, ~ (handler-case
so the client is requesting to reconnect.~%Condition - ~A.~&" (websocket-driver:close-connection old
c)))) "Aborting this old connection since receiving a reconnection request.")
(setf (gethash id *connection-ids*) connection) (t (c)
(setf (gethash connection *connections*) id)) (when *verbose-output*
(format t "Failed to close the old connection when establishing reconnection. ~
This can be normal: The old connection could not work for the client, ~
so the client is requesting to reconnect.~%Condition - ~A.~&"
c))))))
(id (id
(format t "Reconnection id ~A not found. Closing the connection.~%" id) (format t "Reconnection id ~A not found. Closing the connection.~%" id)
(websocket-driver:close-connection connection)) ; Don't send the reason for better security. (websocket-driver:close-connection connection)) ; Don't send the reason for better security.
(t (t
(setf id (random-hex-string)) (setf id (random-hex-string))
(setf (gethash connection *connections*) id) (setf (gethash connection *connections*) id)
(setf (gethash id *connection-ids*) connection) (setf (gethash id *connection-ids*) connection)
(setf (gethash id *connection-data*) (setf (gethash id *connection-data*)
(make-hash-table* :test #'equal)) (make-hash-table* :test #'equal))
(setf (gethash "connection-id" (get-connection-data id)) id) (setf (gethash "connection-id" (get-connection-data id)) id)
(format t "New connection id - ~A - ~A~%" id connection) (format t "New connection id - ~A - ~A~%" id connection)
(websocket-driver:send connection (websocket-driver:send connection
(format nil "clog['connection_id']='~A'" id)) (format nil "clog['connection_id']='~A'" id))
(bordeaux-threads:make-thread (bordeaux-threads:make-thread
(lambda () (lambda ()
(if *break-on-error* (if *break-on-error*
(funcall *on-connect-handler* id) (funcall *on-connect-handler* id)
(handler-case (handler-case
(funcall *on-connect-handler* id) (funcall *on-connect-handler* id)
(t (c) (t (c)
(format t "Condition caught connection ~A - ~A.~&" id c) (format t "Condition caught connection ~A - ~A.~&" id c)
(values 0 c))))) (values 0 c)))))
:name (format nil "CLOG connection ~A" :name (format nil "CLOG connection ~A"
id)))) id))))
(t (c) (t (c)
(format t "Condition caught in handle-new-connection - ~A.~&" c) (format t "Condition caught in handle-new-connection - ~A.~&" c)
(values 0 c)))) (values 0 c))))
@ -162,6 +166,14 @@
(defun handle-close-connection (connection) (defun handle-close-connection (connection)
"Close websocket CONNECTION. (Private)" "Close websocket CONNECTION. (Private)"
(when *verbose-output*
(format t "Connection close request ~A.~%"
connection))
(when *reconnect-delay*
(when *verbose-output*
(format t "Connection close request ~A delayed ~A for reconnects.~%"
connection *reconnect-delay*))
(sleep *reconnect-delay*))
(handler-case (handler-case
(let ((id (gethash connection *connections*))) (let ((id (gethash connection *connections*)))
(when id (when id
@ -203,9 +215,9 @@
(t (c) (t (c)
(format t "Condition caught in clog-server :message - ~A.~&" c) (format t "Condition caught in clog-server :message - ~A.~&" c)
(values 0 c))))) (values 0 c)))))
(websocket-driver:on :error ws (websocket-driver:on :error ws
(lambda (msg) (lambda (msg)
(format t "Websocket error - ~A~&" msg))) (format t "Websocket error - ~A~&" msg)))
(websocket-driver:on :close ws (websocket-driver:on :close ws
(lambda (&key code reason) (lambda (&key code reason)
(declare (ignore code reason)) (declare (ignore code reason))

View file

@ -38,6 +38,7 @@ script."
(*browser-gc-on-ping* variable) (*browser-gc-on-ping* variable)
(*break-on-error* variable) (*break-on-error* variable)
(*disable-clog-debugging* variable) (*disable-clog-debugging* variable)
(*reconnect-delay* variable)
(initialize function) (initialize function)
(random-port function) (random-port function)
@ -87,6 +88,7 @@ script."
(defvar *browser-gc-on-ping* nil "Run a browser-gc on every ping (default nil)") (defvar *browser-gc-on-ping* nil "Run a browser-gc on every ping (default nil)")
(defvar *break-on-error* t "Allow invoking debugger (default t)") (defvar *break-on-error* t "Allow invoking debugger (default t)")
(defvar *disable-clog-debugging* nil "When true turns off debug hooks (default nil)") (defvar *disable-clog-debugging* nil "When true turns off debug hooks (default nil)")
(defvar *reconnect-delay* 3 "Time to delay in seconds for possible reconnect (default 3)")
(defvar *on-connect-handler* nil "New connection event handler.") (defvar *on-connect-handler* nil "New connection event handler.")

View file

@ -84,14 +84,17 @@
(setf *editor-delay-on-eval-file* 60) (setf *editor-delay-on-eval-file* 60)
;; Server Settings ;; Server Settings
;; When true turns off debug hooks ;; when true turns off debug hooks
(setf clog-connection:*disable-clog-debugging* nil) (setf clog-connection:*disable-clog-debugging* nil)
;; Verbose server output ;; verbose server output
(setf clog-connection:*verbose-output* nil) (setf clog-connection:*verbose-output* nil)
;; Run a browser-gc on every ping ;; run a browser-gc on every ping
(setf clog-connection:*browser-gc-on-ping* nil) (setf clog-connection:*browser-gc-on-ping* nil)
;; Allow invoking debugger ;; allow invoking debugger
(setf clog-connection:*break-on-error* t) (setf clog-connection:*break-on-error* t)
;; time to delay for possible reconnect, such as after sleep or
;; long network latenacies.
(setf clog-connection:*reconnect-delay* 3)
;; CLOG Builder REPL ;; CLOG Builder REPL
(setf *clog-repl-use-console* t) (setf *clog-repl-use-console* t)