mirror of
https://github.com/penpot/penpot.git
synced 2025-08-06 07:28:28 +02:00
♻️ Refactor websockets impl to use virtual threads
Removing the use of core.async code and implement code using plain old and familiar synchronous code
This commit is contained in:
Andrey Antukh
parent
14b53a4d5e
commit
2e717882f1
8 changed files with 465 additions and 537 deletions
|
|
@ -5,7 +5,7 @@
|
|||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.util.websocket
|
||||
"A general protocol implementation on top of websockets."
|
||||
"A general protocol implementation on top of websockets using vthreads."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
|
|
@ -13,22 +13,42 @@
|
|||
[app.common.uuid :as uuid]
|
||||
[app.loggers.audit :refer [parse-client-ip]]
|
||||
[app.util.time :as dt]
|
||||
[clojure.core.async :as a]
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.csp :as sp]
|
||||
[yetti.request :as yr]
|
||||
[yetti.util :as yu]
|
||||
[yetti.websocket :as yws])
|
||||
(:import
|
||||
java.nio.ByteBuffer))
|
||||
|
||||
(declare decode-beat)
|
||||
(declare encode-beat)
|
||||
(declare start-io-loop)
|
||||
(declare ws-ping!)
|
||||
(declare ws-send!)
|
||||
(declare filter-options)
|
||||
|
||||
(def noop (constantly nil))
|
||||
(def identity-3 (fn [_ _ o] o))
|
||||
(def max-missed-heartbeats 3)
|
||||
(def heartbeat-interval 5000)
|
||||
|
||||
(defn- encode-beat
|
||||
[n]
|
||||
(doto (ByteBuffer/allocate 8)
|
||||
(.putLong n)
|
||||
(.rewind)))
|
||||
|
||||
(defn- decode-beat
|
||||
[^ByteBuffer buffer]
|
||||
(when (= 8 (.capacity buffer))
|
||||
(.rewind buffer)
|
||||
(.getLong buffer)))
|
||||
|
||||
(defn- wrap-handler
|
||||
[handler]
|
||||
(fn [wsp message]
|
||||
(try
|
||||
(handler wsp message)
|
||||
(catch Throwable cause
|
||||
(if (ex/error? cause)
|
||||
{:type :error :error (ex-data cause)}
|
||||
{:type :error :error {:message (ex-message cause)}})))))
|
||||
|
||||
(declare start-io-loop!)
|
||||
|
||||
(defn handler
|
||||
"A WebSocket upgrade handler factory. Returns a handler that can be
|
||||
|
|
@ -46,12 +66,11 @@
|
|||
::on-connect
|
||||
::input-buff-size
|
||||
::output-buff-size
|
||||
::handler
|
||||
::idle-timeout]
|
||||
:or {input-buff-size 64
|
||||
output-buff-size 64
|
||||
idle-timeout 60000
|
||||
on-connect noop
|
||||
on-connect identity
|
||||
on-snd-message identity-3
|
||||
on-rcv-message identity-3}
|
||||
:as options}]
|
||||
|
|
@ -61,91 +80,65 @@
|
|||
(assert (fn? on-connect) "'on-connect' should be a function")
|
||||
|
||||
(fn [{:keys [::yws/channel] :as request}]
|
||||
(let [input-ch (a/chan input-buff-size)
|
||||
output-ch (a/chan output-buff-size)
|
||||
hbeat-ch (a/chan (a/sliding-buffer 6))
|
||||
close-ch (a/chan)
|
||||
stop-ch (a/chan)
|
||||
(let [input-ch (sp/chan :buf input-buff-size)
|
||||
output-ch (sp/chan :buf output-buff-size)
|
||||
hbeat-ch (sp/chan :buf (sp/sliding-buffer 6))
|
||||
close-ch (sp/chan)
|
||||
|
||||
ip-addr (parse-client-ip request)
|
||||
uagent (yr/get-header request "user-agent")
|
||||
id (uuid/next)
|
||||
state (atom {})
|
||||
beats (atom #{})
|
||||
|
||||
options (-> (filter-options options)
|
||||
(merge {::id id
|
||||
::created-at (dt/now)
|
||||
::input-ch input-ch
|
||||
::heartbeat-ch hbeat-ch
|
||||
::output-ch output-ch
|
||||
::close-ch close-ch
|
||||
::stop-ch stop-ch
|
||||
::channel channel
|
||||
::remote-addr ip-addr
|
||||
::user-agent uagent})
|
||||
(atom))
|
||||
|
||||
;; call the on-connect hook and memoize the on-terminate instance
|
||||
on-terminate (on-connect options)
|
||||
options (-> options
|
||||
(update ::handler wrap-handler)
|
||||
(assoc ::id id)
|
||||
(assoc ::state state)
|
||||
(assoc ::beats beats)
|
||||
(assoc ::created-at (dt/now))
|
||||
(assoc ::input-ch input-ch)
|
||||
(assoc ::heartbeat-ch hbeat-ch)
|
||||
(assoc ::output-ch output-ch)
|
||||
(assoc ::close-ch close-ch)
|
||||
(assoc ::channel channel)
|
||||
(assoc ::remote-addr ip-addr)
|
||||
(assoc ::user-agent uagent)
|
||||
(on-connect))
|
||||
|
||||
on-ws-open
|
||||
(fn [channel]
|
||||
(l/trace :fn "on-ws-open" :conn-id id)
|
||||
(yws/idle-timeout! channel (dt/duration idle-timeout)))
|
||||
(let [timeout (dt/duration idle-timeout)
|
||||
name (str "penpot/websocket/io-loop/" id)]
|
||||
(yws/idle-timeout! channel timeout)
|
||||
(px/fn->thread (partial start-io-loop! options)
|
||||
{:name name :virtual true})))
|
||||
|
||||
on-ws-terminate
|
||||
(fn [_ code reason]
|
||||
(l/trace :fn "on-ws-terminate" :conn-id id :code code :reason reason)
|
||||
(a/close! close-ch))
|
||||
(l/trace :fn "on-ws-terminate"
|
||||
:conn-id id
|
||||
:code code
|
||||
:reason reason)
|
||||
(sp/close! close-ch))
|
||||
|
||||
on-ws-error
|
||||
(fn [_ error]
|
||||
(when-not (or (instance? java.nio.channels.ClosedChannelException error)
|
||||
(instance? java.net.SocketException error)
|
||||
(instance? java.io.IOException error))
|
||||
(l/error :fn "on-ws-error" :conn-id id
|
||||
:hint (ex-message error)
|
||||
:cause error))
|
||||
(on-ws-terminate nil 8801 "close after error"))
|
||||
(fn [_ cause]
|
||||
(sp/close! close-ch cause))
|
||||
|
||||
on-ws-message
|
||||
(fn [_ message]
|
||||
(try
|
||||
(let [message (on-rcv-message options message)
|
||||
message (t/decode-str message)]
|
||||
(a/offer! input-ch message)
|
||||
(swap! options assoc ::last-activity-at (dt/now)))
|
||||
(catch Throwable e
|
||||
(l/warn :hint "error on decoding incoming message from websocket"
|
||||
:wsmsg (pr-str message)
|
||||
:cause e)
|
||||
(a/>! close-ch [8802 "decode error"])
|
||||
(a/close! close-ch))))
|
||||
(sp/offer! input-ch message)
|
||||
(swap! state assoc ::last-activity-at (dt/now)))
|
||||
|
||||
on-ws-pong
|
||||
(fn [_ buffers]
|
||||
(a/>!! hbeat-ch (yu/copy-many buffers)))]
|
||||
;; (l/trace :fn "on-ws-pong" :buffers (pr-str buffers))
|
||||
(sp/put! hbeat-ch (yu/copy-many buffers)))]
|
||||
|
||||
;; Wait a close signal
|
||||
(a/go
|
||||
(let [[code reason] (a/<! close-ch)]
|
||||
(a/close! stop-ch)
|
||||
(a/close! hbeat-ch)
|
||||
(a/close! output-ch)
|
||||
(a/close! input-ch)
|
||||
|
||||
(when (and code reason)
|
||||
(l/trace :hint "close channel condition" :code code :reason reason)
|
||||
(yws/close! channel code reason))
|
||||
|
||||
(when (fn? on-terminate)
|
||||
(on-terminate))
|
||||
|
||||
(l/trace :hint "connection terminated")))
|
||||
|
||||
;; React on messages received from the client
|
||||
(a/go
|
||||
(a/<! (start-io-loop options handler on-snd-message on-ws-terminate))
|
||||
(l/trace :hint "io loop terminated"))
|
||||
(yws/on-close! channel (fn [_]
|
||||
(sp/close! close-ch)))
|
||||
|
||||
{:on-open on-ws-open
|
||||
:on-error on-ws-error
|
||||
|
|
@ -153,118 +146,81 @@
|
|||
:on-text on-ws-message
|
||||
:on-pong on-ws-pong})))
|
||||
|
||||
(defn- ws-send!
|
||||
[channel s]
|
||||
(let [ch (a/chan 1)]
|
||||
(defn- handle-ping!
|
||||
[{:keys [::id ::beats ::channel] :as wsp} beat-id]
|
||||
(l/trace :hint "ping" :beat beat-id :conn-id id)
|
||||
(yws/ping! channel (encode-beat beat-id))
|
||||
(let [issued (swap! beats conj (long beat-id))]
|
||||
(not (>= (count issued) max-missed-heartbeats))))
|
||||
|
||||
(defn- start-io-loop!
|
||||
[{:keys [::id ::close-ch ::input-ch ::output-ch ::heartbeat-ch ::channel ::handler ::beats ::on-rcv-message ::on-snd-message] :as wsp}]
|
||||
(px/thread
|
||||
{:name (str "penpot/websocket/io-loop/" id)
|
||||
:virtual true}
|
||||
(try
|
||||
(yws/send! channel s (fn [e]
|
||||
(when e (a/offer! ch e))
|
||||
(a/close! ch)))
|
||||
(handler wsp {:type :open})
|
||||
(loop [i 0]
|
||||
(let [ping-ch (sp/timeout-chan heartbeat-interval)
|
||||
[msg p] (sp/alts! [close-ch input-ch output-ch heartbeat-ch ping-ch])]
|
||||
(when (yws/connected? channel)
|
||||
(cond
|
||||
(identical? p ping-ch)
|
||||
(if (handle-ping! wsp i)
|
||||
(recur (inc i))
|
||||
(yws/close! channel 8802 "missing to many pings"))
|
||||
|
||||
(or (identical? p close-ch) (nil? msg))
|
||||
(do :nothing)
|
||||
|
||||
(identical? p heartbeat-ch)
|
||||
(let [beat (decode-beat msg)]
|
||||
;; (l/trace :hint "pong" :beat beat :conn-id id)
|
||||
(swap! beats disj beat)
|
||||
(recur i))
|
||||
|
||||
(identical? p input-ch)
|
||||
(let [message (t/decode-str msg)
|
||||
message (on-rcv-message message)
|
||||
{:keys [request-id] :as response} (handler wsp message)]
|
||||
(when (map? response)
|
||||
(sp/put! output-ch
|
||||
(cond-> response
|
||||
(some? request-id)
|
||||
(assoc :request-id request-id))))
|
||||
(recur i))
|
||||
|
||||
(identical? p output-ch)
|
||||
(let [message (on-snd-message msg)
|
||||
message (t/encode-str message {:type :json-verbose})]
|
||||
;; (l/trace :hint "writing message to output" :message msg)
|
||||
(yws/send! channel message)
|
||||
(recur i))))))
|
||||
|
||||
(catch java.nio.channels.ClosedChannelException _)
|
||||
(catch java.net.SocketException _)
|
||||
(catch java.io.IOException _)
|
||||
|
||||
(catch InterruptedException _
|
||||
(l/debug :hint "websocket thread interrumpted" :conn-id id))
|
||||
|
||||
(catch Throwable cause
|
||||
(a/offer! ch cause)
|
||||
(a/close! ch)))
|
||||
ch))
|
||||
(l/error :hint "unhandled exception on websocket thread"
|
||||
:conn-id id
|
||||
:cause cause))
|
||||
|
||||
(defn- ws-ping!
|
||||
[channel s]
|
||||
(let [ch (a/chan 1)]
|
||||
(try
|
||||
(yws/ping! channel s (fn [e]
|
||||
(when e (a/offer! ch e))
|
||||
(a/close! ch)))
|
||||
(catch Throwable cause
|
||||
(a/offer! ch cause)
|
||||
(a/close! ch)))
|
||||
ch))
|
||||
(finally
|
||||
(handler wsp {:type :close})
|
||||
|
||||
(defn- encode-beat
|
||||
[n]
|
||||
(doto (ByteBuffer/allocate 8)
|
||||
(.putLong n)
|
||||
(.rewind)))
|
||||
(when (yws/connected? channel)
|
||||
;; NOTE: we need to ignore all exceptions here because
|
||||
;; there can be a race condition that first returns that
|
||||
;; channel is connected but on closing, will raise that
|
||||
;; channel is already closed.
|
||||
(ex/ignoring
|
||||
(yws/close! channel 8899 "terminated")))
|
||||
|
||||
(defn- decode-beat
|
||||
[^ByteBuffer buffer]
|
||||
(when (= 8 (.capacity buffer))
|
||||
(.rewind buffer)
|
||||
(.getLong buffer)))
|
||||
(when-let [on-disconnect (::on-disconnect wsp)]
|
||||
(on-disconnect))
|
||||
|
||||
(defn- wrap-handler
|
||||
[handler]
|
||||
(fn [wsp message]
|
||||
(locking wsp
|
||||
(handler wsp message))))
|
||||
|
||||
(def max-missed-heartbeats 3)
|
||||
(def heartbeat-interval 5000)
|
||||
|
||||
(defn- start-io-loop
|
||||
[wsp handler on-snd-message on-ws-terminate]
|
||||
(let [input-ch (::input-ch @wsp)
|
||||
output-ch (::output-ch @wsp)
|
||||
stop-ch (::stop-ch @wsp)
|
||||
hbeat-pong-ch (::heartbeat-ch @wsp)
|
||||
channel (::channel @wsp)
|
||||
conn-id (::id @wsp)
|
||||
handler (wrap-handler handler)
|
||||
beats (atom #{})
|
||||
choices [stop-ch
|
||||
input-ch
|
||||
output-ch
|
||||
hbeat-pong-ch]]
|
||||
|
||||
;; Start IO loop
|
||||
(a/go
|
||||
(a/<! (handler wsp {:type :connect}))
|
||||
(a/<! (a/go-loop [i 0]
|
||||
(let [hbeat-ping-ch (a/timeout heartbeat-interval)
|
||||
[v p] (a/alts! (conj choices hbeat-ping-ch))]
|
||||
(cond
|
||||
(not (yws/connected? channel))
|
||||
(on-ws-terminate nil 8800 "channel disconnected")
|
||||
|
||||
(= p hbeat-ping-ch)
|
||||
(do
|
||||
(l/trace :hint "ping" :beat i :conn-id conn-id)
|
||||
(a/<! (ws-ping! channel (encode-beat i)))
|
||||
(let [issued (swap! beats conj (long i))]
|
||||
(if (>= (count issued) max-missed-heartbeats)
|
||||
(on-ws-terminate nil 8802 "heartbeat: timeout")
|
||||
(recur (inc i)))))
|
||||
|
||||
(= p hbeat-pong-ch)
|
||||
(let [beat (decode-beat v)]
|
||||
(l/trace :hint "pong" :beat beat :conn-id conn-id)
|
||||
(swap! beats disj beat)
|
||||
(recur i))
|
||||
|
||||
(= p input-ch)
|
||||
(let [result (a/<! (handler wsp v))]
|
||||
;; (l/trace :hint "message received" :message v)
|
||||
(cond
|
||||
(ex/error? result)
|
||||
(a/>! output-ch {:type :error :error (ex-data result)})
|
||||
|
||||
(ex/exception? result)
|
||||
(a/>! output-ch {:type :error :error {:message (ex-message result)}})
|
||||
|
||||
(map? result)
|
||||
(a/>! output-ch (cond-> result (:request-id v) (assoc :request-id (:request-id v)))))
|
||||
(recur i))
|
||||
|
||||
(= p output-ch)
|
||||
(let [v (on-snd-message wsp v)]
|
||||
;; (l/trace :hint "writing message to output" :message v)
|
||||
(a/<! (ws-send! channel (t/encode-str v)))
|
||||
(recur i))))))
|
||||
|
||||
(a/<! (handler wsp {:type :disconnect})))))
|
||||
|
||||
(defn- filter-options
|
||||
"Remove from options all namespace qualified keys that matches the
|
||||
current namespace."
|
||||
[options]
|
||||
(into {}
|
||||
(remove (fn [[key]]
|
||||
(= (namespace key) "app.util.websocket")))
|
||||
options))
|
||||
(l/trace :hint "websocket thread terminated" :conn-id id)))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue