diff --git a/source/clog-connection-websockets.lisp b/source/clog-connection-websockets.lisp index 497a499..b942e48 100644 --- a/source/clog-connection-websockets.lisp +++ b/source/clog-connection-websockets.lisp @@ -41,42 +41,46 @@ "Handle new incoming websocket CONNECTIONS with ID from boot page. (Private)" (handler-case (cond ((and id (gethash id *connection-data*)) - (format t "Reconnection id - ~A to ~A~%" id connection) - (handler-case - (websocket-driver:close-connection (gethash id *connection-ids*) - "Aborting this old connection since receiving a reconnection request.") - (t (c) - (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)))) - (setf (gethash id *connection-ids*) connection) - (setf (gethash connection *connections*) id)) + (format t "Reconnection id - ~A to ~A~%" id connection) + (let ((old (gethash id *connection-ids*))) + (when *verbose-output* + (format t "Transfer id - ~A => ~A" old connection)) + (setf (gethash old *connections*) nil) + (setf (gethash connection *connections*) id) + (setf (gethash id *connection-ids*) connection) + (handler-case + (websocket-driver:close-connection old + "Aborting this old connection since receiving a reconnection request.") + (t (c) + (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 - (format t "Reconnection id ~A not found. Closing the connection.~%" id) - (websocket-driver:close-connection connection)) ; Don't send the reason for better security. + (format t "Reconnection id ~A not found. Closing the connection.~%" id) + (websocket-driver:close-connection connection)) ; Don't send the reason for better security. (t - (setf id (random-hex-string)) - (setf (gethash connection *connections*) id) - (setf (gethash id *connection-ids*) connection) - (setf (gethash id *connection-data*) - (make-hash-table* :test #'equal)) - (setf (gethash "connection-id" (get-connection-data id)) id) - (format t "New connection id - ~A - ~A~%" id connection) - (websocket-driver:send connection - (format nil "clog['connection_id']='~A'" id)) - (bordeaux-threads:make-thread - (lambda () - (if *break-on-error* - (funcall *on-connect-handler* id) - (handler-case - (funcall *on-connect-handler* id) - (t (c) - (format t "Condition caught connection ~A - ~A.~&" id c) - (values 0 c))))) - :name (format nil "CLOG connection ~A" - id)))) + (setf id (random-hex-string)) + (setf (gethash connection *connections*) id) + (setf (gethash id *connection-ids*) connection) + (setf (gethash id *connection-data*) + (make-hash-table* :test #'equal)) + (setf (gethash "connection-id" (get-connection-data id)) id) + (format t "New connection id - ~A - ~A~%" id connection) + (websocket-driver:send connection + (format nil "clog['connection_id']='~A'" id)) + (bordeaux-threads:make-thread + (lambda () + (if *break-on-error* + (funcall *on-connect-handler* id) + (handler-case + (funcall *on-connect-handler* id) + (t (c) + (format t "Condition caught connection ~A - ~A.~&" id c) + (values 0 c))))) + :name (format nil "CLOG connection ~A" + id)))) (t (c) (format t "Condition caught in handle-new-connection - ~A.~&" c) (values 0 c)))) @@ -162,6 +166,14 @@ (defun handle-close-connection (connection) "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 (let ((id (gethash connection *connections*))) (when id @@ -203,9 +215,9 @@ (t (c) (format t "Condition caught in clog-server :message - ~A.~&" c) (values 0 c))))) - (websocket-driver:on :error ws - (lambda (msg) - (format t "Websocket error - ~A~&" msg))) + (websocket-driver:on :error ws + (lambda (msg) + (format t "Websocket error - ~A~&" msg))) (websocket-driver:on :close ws (lambda (&key code reason) (declare (ignore code reason)) diff --git a/source/clog-connection.lisp b/source/clog-connection.lisp index 7865da3..8d40ff0 100644 --- a/source/clog-connection.lisp +++ b/source/clog-connection.lisp @@ -38,6 +38,7 @@ script." (*browser-gc-on-ping* variable) (*break-on-error* variable) (*disable-clog-debugging* variable) + (*reconnect-delay* variable) (initialize 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 *break-on-error* t "Allow invoking debugger (default t)") (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.") diff --git a/tools/preferences.lisp.sample b/tools/preferences.lisp.sample index 831440e..064ee97 100644 --- a/tools/preferences.lisp.sample +++ b/tools/preferences.lisp.sample @@ -84,14 +84,17 @@ (setf *editor-delay-on-eval-file* 60) ;; Server Settings -;; When true turns off debug hooks +;; when true turns off debug hooks (setf clog-connection:*disable-clog-debugging* nil) -;; Verbose server output +;; verbose server output (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) -;; Allow invoking debugger +;; allow invoking debugger (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 (setf *clog-repl-use-console* t)