super nitpicky code formatting
i apologize to anyone looking at this commit and wondering why i would do this, but all these little "off" formatting things have been bugging me all day while looking at this code. i simply had to do something.
This commit is contained in:
parent
4e63631854
commit
9d314c4d88
|
|
@ -4,15 +4,19 @@
|
|||
[immutant.web.async :as iasync]
|
||||
[net.thegeez.browserchannel.async-adapter :as bc-async-adapter]))
|
||||
|
||||
(deftype ImmutantResponse [channel]
|
||||
(deftype ImmutantResponse
|
||||
[channel]
|
||||
bc-async-adapter/IAsyncAdapter
|
||||
|
||||
(head [this status headers]
|
||||
(let [headers (assoc headers "Transfer-Encoding" "chunked")]
|
||||
(iasync/send! channel {:status status :headers headers})))
|
||||
|
||||
(write-chunk [this data]
|
||||
(if (iasync/open? channel)
|
||||
(iasync/send! channel data)
|
||||
(throw bc-async-adapter/ConnectionClosedException)))
|
||||
|
||||
(close [this]
|
||||
(iasync/close channel)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
(ns net.thegeez.browserchannel.jetty-async-adapter
|
||||
"BrowserChannel adapter for the Jetty webserver, with async HTTP."
|
||||
(:import [org.eclipse.jetty.server.handler AbstractHandler]
|
||||
(:import
|
||||
[org.eclipse.jetty.server.handler AbstractHandler]
|
||||
[org.eclipse.jetty.server Server Request Response]
|
||||
[org.eclipse.jetty.server.nio SelectChannelConnector]
|
||||
[org.eclipse.jetty.server.ssl SslSelectChannelConnector]
|
||||
|
|
@ -8,25 +9,30 @@
|
|||
[org.eclipse.jetty.continuation Continuation ContinuationSupport ContinuationListener]
|
||||
[javax.servlet.http HttpServletRequest]
|
||||
[java.security KeyStore])
|
||||
(:require [ring.util.servlet :as servlet]
|
||||
(:require
|
||||
[ring.util.servlet :as servlet]
|
||||
[net.thegeez.browserchannel.async-adapter :as async-adapter]))
|
||||
|
||||
;; Based on ring-jetty-async-adapter by Mark McGranaghan
|
||||
;; (https://github.com/mmcgrana/ring/tree/jetty-async)
|
||||
;; This has failed write support
|
||||
|
||||
(deftype JettyAsyncResponse [^Continuation continuation]
|
||||
(deftype JettyAsyncResponse
|
||||
[^Continuation continuation]
|
||||
async-adapter/IAsyncAdapter
|
||||
|
||||
(head [this status headers]
|
||||
(doto (.getServletResponse continuation)
|
||||
(servlet/update-servlet-response {:status status, :headers (assoc headers "Transfer-Encoding" "chunked")})
|
||||
(servlet/update-servlet-response {:status status :headers (assoc headers "Transfer-Encoding" "chunked")})
|
||||
(.flushBuffer)))
|
||||
|
||||
(write-chunk [this data]
|
||||
(doto (.getWriter (.getServletResponse continuation))
|
||||
(.write ^String data)
|
||||
(.flush))
|
||||
(when (.checkError (.getWriter (.getServletResponse continuation)))
|
||||
(throw async-adapter/ConnectionClosedException)))
|
||||
|
||||
(close [this]
|
||||
(doto (.getWriter (.getServletResponse continuation))
|
||||
(.write "")
|
||||
|
|
|
|||
|
|
@ -1,9 +1,11 @@
|
|||
(ns net.thegeez.browserchannel.server
|
||||
"BrowserChannel server implementation in Clojure."
|
||||
(:require [ring.middleware.params :as params]
|
||||
(:import
|
||||
[java.util.concurrent ScheduledExecutorService Executors TimeUnit Callable ScheduledFuture])
|
||||
(:require
|
||||
[ring.middleware.params :as params]
|
||||
[clojure.data.json :as json]
|
||||
[net.thegeez.browserchannel.async-adapter :as async-adapter])
|
||||
(:import [java.util.concurrent ScheduledExecutorService Executors TimeUnit Callable ScheduledFuture]))
|
||||
[net.thegeez.browserchannel.async-adapter :as async-adapter]))
|
||||
|
||||
;; @todo: out of order acks and maps - AKH the maps at least is taken care of.
|
||||
;; @todo use a more specific Exception for failing writes, which
|
||||
|
|
@ -42,22 +44,27 @@
|
|||
|
||||
;;;;; Utils
|
||||
;; to create session ids
|
||||
(defn uuid [] (str (java.util.UUID/randomUUID)))
|
||||
(defn uuid
|
||||
[]
|
||||
(str (java.util.UUID/randomUUID)))
|
||||
|
||||
(def scheduler (Executors/newScheduledThreadPool 1))
|
||||
|
||||
;; scheduling a task returns a ScheduledFuture, which can be stopped
|
||||
;; with (.cancel task false) false says not to interrupt running tasks
|
||||
(defn schedule [^Callable f ^long secs]
|
||||
(defn schedule
|
||||
[^Callable f ^long secs]
|
||||
(.schedule ^ScheduledExecutorService scheduler f secs TimeUnit/SECONDS))
|
||||
|
||||
;; json responses are sent as "size-of-response\njson-response"
|
||||
(defn size-json-str [^String json]
|
||||
(defn size-json-str
|
||||
[^String json]
|
||||
(let [size (alength (.getBytes json "UTF-8"))]
|
||||
(str size "\n" json)))
|
||||
|
||||
;; make sure the root URI for channels starts with a / for route matching
|
||||
(defn standard-base [s]
|
||||
(defn standard-base
|
||||
[s]
|
||||
(let [wofirst (if (= \/ (first s))
|
||||
(apply str (rest s))
|
||||
s)
|
||||
|
|
@ -71,7 +78,8 @@
|
|||
(map standard-base ["foo" "/foo" "foo/" "/foo"])))
|
||||
|
||||
;; type preserving drop upto for queueus
|
||||
(defn drop-queue [queue id]
|
||||
(defn drop-queue
|
||||
[queue id]
|
||||
(let [head (peek queue)]
|
||||
(if-not head
|
||||
queue
|
||||
|
|
@ -82,7 +90,8 @@
|
|||
|
||||
;; Key value pairs do not always come ordered by request number.
|
||||
;; E.g. {req0_key1 val01, req1_key1 val11, req0_key2 val02, req1_key2 val12}
|
||||
(defn transform-url-data [data]
|
||||
(defn transform-url-data
|
||||
[data]
|
||||
(let [ofs (get data "ofs" "0")
|
||||
pieces (dissoc data "count" "ofs")]
|
||||
{:ofs (Long/parseLong ofs)
|
||||
|
|
@ -115,7 +124,8 @@
|
|||
;; "req1_abc" "def"}
|
||||
;; =>
|
||||
;;{:ofs 0 :maps [{"x" "3" "y" "10"},{"abc": "def"}]}
|
||||
(defn get-maps [req]
|
||||
(defn get-maps
|
||||
[req]
|
||||
(let [data (:form-params req)]
|
||||
(when-not (zero? (count data))
|
||||
;; number of entries in form-params,
|
||||
|
|
@ -125,7 +135,8 @@
|
|||
(:maps (transform-url-data data)))))
|
||||
|
||||
;; rather crude but straight from google
|
||||
(defn error-response [status-code message]
|
||||
(defn error-response
|
||||
[status-code message]
|
||||
{:status status-code
|
||||
:body (str "<html><body><h1>" message "</h1></body></html>")})
|
||||
|
||||
|
|
@ -147,11 +158,13 @@
|
|||
(set-error-mode! listeners-agent :continue)
|
||||
|
||||
|
||||
(defn add-listener [session-id event-key f]
|
||||
(defn add-listener
|
||||
[session-id event-key f]
|
||||
(send-off listeners-agent
|
||||
update-in [session-id event-key] #(conj (or % []) f)))
|
||||
|
||||
(defn notify-listeners [session-id request event-key & data]
|
||||
(defn notify-listeners
|
||||
[session-id request event-key & data]
|
||||
(send-off listeners-agent
|
||||
(fn [listeners]
|
||||
(doseq [callback (get-in listeners [session-id event-key])]
|
||||
|
|
@ -169,21 +182,27 @@
|
|||
(write-end [this]))
|
||||
|
||||
;; for writing on backchannel to non-IE clients
|
||||
(deftype XHRWriter [;; respond calls functions on the continuation
|
||||
(deftype XHRWriter
|
||||
[;; respond calls functions on the continuation
|
||||
respond
|
||||
headers]
|
||||
IResponseWrapper
|
||||
|
||||
(write-head [this]
|
||||
(async-adapter/head respond 200 headers))
|
||||
|
||||
(write [this data]
|
||||
(write-raw this (size-json-str data)))
|
||||
|
||||
(write-raw [this data]
|
||||
(async-adapter/write-chunk respond data))
|
||||
|
||||
(write-end [this]
|
||||
(async-adapter/close respond)))
|
||||
|
||||
;; for writing on backchannels to IE clients
|
||||
(deftype IEWriter [;; respond calls functions on the continuation
|
||||
(deftype IEWriter
|
||||
[;; respond calls functions on the continuation
|
||||
respond
|
||||
headers
|
||||
;; DOMAIN value from query string
|
||||
|
|
@ -194,21 +213,25 @@
|
|||
;; likewise for write raw, used during test phase
|
||||
^{:volatile-mutable true} write-raw-padding-sent]
|
||||
IResponseWrapper
|
||||
|
||||
(write-head [this]
|
||||
(async-adapter/head respond 200 (merge headers ie-headers))
|
||||
(async-adapter/write-chunk respond "<html><body>\n")
|
||||
(when (seq domain)
|
||||
(async-adapter/write-chunk respond (str "<script>try{document.domain=\"" (pr-str (json/write-str domain)) "\";}catch(e){}</script>\n"))))
|
||||
|
||||
(write [this data]
|
||||
(async-adapter/write-chunk respond (str "<script>try {parent.m(" (pr-str data) ")} catch(e) {}</script>\n"))
|
||||
(when-not write-padding-sent
|
||||
(async-adapter/write-chunk respond ie-stream-padding)
|
||||
(set! write-padding-sent true)))
|
||||
|
||||
(write-raw [this data]
|
||||
(async-adapter/write-chunk respond (str "<script>try {parent.m(" (pr-str data) ")} catch(e) {}</script>\n"))
|
||||
(when-not write-raw-padding-sent
|
||||
(async-adapter/write-chunk respond ie-stream-padding)
|
||||
(set! write-raw-padding-sent true)))
|
||||
|
||||
(write-end [this]
|
||||
(async-adapter/write-chunk respond "<script>try {parent.d(); }catch (e){}</script>\n")
|
||||
(async-adapter/close respond)))
|
||||
|
|
@ -220,10 +243,10 @@
|
|||
(acknowledge-id [this id])
|
||||
(to-flush [this])
|
||||
(last-acknowledged-id [this])
|
||||
(outstanding-bytes [this])
|
||||
)
|
||||
(outstanding-bytes [this]))
|
||||
|
||||
(deftype ArrayBuffer [;; id of the last array that is conj'ed, can't
|
||||
(deftype ArrayBuffer
|
||||
[;; id of the last array that is conj'ed, can't
|
||||
;; always be derived because flush buffer might
|
||||
;; be empty
|
||||
array-id
|
||||
|
|
@ -238,9 +261,9 @@
|
|||
;; arrays to be sent out, may contain arrays
|
||||
;; that were in to-acknowledge-arrays but queued
|
||||
;; again for resending
|
||||
to-flush-arrays
|
||||
]
|
||||
to-flush-arrays]
|
||||
IArrayBuffer
|
||||
|
||||
(queue [this string]
|
||||
(let [next-array-id (inc array-id)]
|
||||
(ArrayBuffer. next-array-id
|
||||
|
|
@ -277,6 +300,7 @@
|
|||
clojure.lang.PersistentQueue/EMPTY)]))
|
||||
(last-acknowledged-id [this]
|
||||
last-acknowledged-id)
|
||||
|
||||
;; the sum of all the data that is still to be send
|
||||
(outstanding-bytes [this]
|
||||
(reduce + 0 (map (comp count second) to-flush-arrays))))
|
||||
|
|
@ -318,7 +342,8 @@
|
|||
;; removes session for sessions
|
||||
(close [this request message]))
|
||||
|
||||
(defrecord BackChannel [;; respond wraps the continuation, which is
|
||||
(defrecord BackChannel
|
||||
[;; respond wraps the continuation, which is
|
||||
;; the actual connection of the backward
|
||||
;; channel to the client
|
||||
respond
|
||||
|
|
@ -329,7 +354,8 @@
|
|||
|
||||
(defn to-pair [p] (str "[" (first p) "," (second p) "]"))
|
||||
|
||||
(defrecord Session [;; must be unique
|
||||
(defrecord Session
|
||||
[;; must be unique
|
||||
id
|
||||
|
||||
;; {:address
|
||||
|
|
@ -358,6 +384,7 @@
|
|||
;; reconnect to its session
|
||||
session-timeout]
|
||||
ISession
|
||||
|
||||
(clear-back-channel [this]
|
||||
(try
|
||||
(when back-channel
|
||||
|
|
@ -369,6 +396,7 @@
|
|||
clear-heartbeat
|
||||
(assoc :back-channel nil)
|
||||
refresh-session-timeout))
|
||||
|
||||
(set-back-channel [this respond req]
|
||||
(let [bc (BackChannel. respond
|
||||
;; can we stream responses
|
||||
|
|
@ -389,12 +417,14 @@
|
|||
;; try to send any data that was buffered
|
||||
;; while there was no backchannel
|
||||
flush-buffer)))
|
||||
|
||||
(clear-heartbeat [this]
|
||||
(when heartbeat-timeout
|
||||
(.cancel ^ScheduledFuture heartbeat-timeout
|
||||
false ;; do not interrupt running tasks
|
||||
))
|
||||
(assoc this :heartbeat-timeout nil))
|
||||
|
||||
(refresh-heartbeat [this]
|
||||
(-> this
|
||||
clear-heartbeat
|
||||
|
|
@ -402,30 +432,37 @@
|
|||
;; *agent* not bound when executed later
|
||||
;; through schedule, therefor passed explicitly
|
||||
(let [session-agent *agent*]
|
||||
(schedule (fn []
|
||||
(schedule
|
||||
(fn []
|
||||
(send-off session-agent #(-> %
|
||||
(queue-string noop-string)
|
||||
flush-buffer)))
|
||||
(:heartbeat-interval details))))))
|
||||
|
||||
(clear-session-timeout [this]
|
||||
(when session-timeout
|
||||
(.cancel ^ScheduledFuture session-timeout
|
||||
false ;; do not interrupt running tasks
|
||||
))
|
||||
(assoc this :session-timeout nil))
|
||||
|
||||
(refresh-session-timeout [this]
|
||||
(-> this
|
||||
clear-session-timeout
|
||||
(assoc :session-timeout
|
||||
(let [session-agent *agent*]
|
||||
(schedule (fn []
|
||||
(schedule
|
||||
(fn []
|
||||
(send-off session-agent close nil "Timed out"))
|
||||
(:session-timeout-interval details))))))
|
||||
|
||||
(queue-string [this string]
|
||||
(update-in this [:array-buffer] queue string))
|
||||
|
||||
(acknowledge-arrays [this array-id]
|
||||
(let [array-id (Long/parseLong array-id)]
|
||||
(update-in this [:array-buffer] acknowledge-id array-id)))
|
||||
|
||||
;; tries to do the actual writing to the client
|
||||
;; @todo the composition is a bit awkward in this method due to the
|
||||
;; try catch and if mix
|
||||
|
|
@ -464,9 +501,9 @@
|
|||
))
|
||||
this ;; do nothing if buffer is empty
|
||||
)))
|
||||
|
||||
;; closes the session and removes it from sessions
|
||||
(close [this request message]
|
||||
|
||||
(-> this
|
||||
clear-back-channel
|
||||
clear-session-timeout
|
||||
|
|
@ -479,7 +516,8 @@
|
|||
|
||||
;; creates a session agent wrapping session data and
|
||||
;; adds the session to sessions
|
||||
(defn create-session-agent [req options]
|
||||
(defn create-session-agent
|
||||
[req options]
|
||||
(let [{initial-rid "RID" ;; identifier for forward channel
|
||||
app-version "CVER" ;; client can specify a custom app-version
|
||||
old-session-id "OSID"
|
||||
|
|
@ -526,7 +564,8 @@
|
|||
(if on-open (on-open id req)))
|
||||
session-agent)))
|
||||
|
||||
(defn session-status [session]
|
||||
(defn session-status
|
||||
[session]
|
||||
(let [has-back-channel (if (:back-channel session) 1 0)
|
||||
array-buffer (:array-buffer session)]
|
||||
[has-back-channel (last-acknowledged-id array-buffer) (outstanding-bytes array-buffer)]))
|
||||
|
|
@ -534,13 +573,15 @@
|
|||
;; convience function to send data to a session
|
||||
;; the data will be queued until there is a backchannel to send it
|
||||
;; over
|
||||
(defn send-string [session-id string]
|
||||
(defn send-string
|
||||
[session-id string]
|
||||
(when-let [session-agent (get @sessions session-id)]
|
||||
(send-off session-agent #(-> %
|
||||
(queue-string string)
|
||||
flush-buffer))))
|
||||
|
||||
(defn send-map [session-id map]
|
||||
(defn send-map
|
||||
[session-id map]
|
||||
(send-string session-id (json/write-str map)))
|
||||
|
||||
(defn send-map-to-all
|
||||
|
|
@ -559,7 +600,8 @@
|
|||
|
||||
;; wrap the respond function from :reactor with the proper
|
||||
;; responsewrapper for either IE or other clients
|
||||
(defn wrap-continuation-writers [handler options]
|
||||
(defn wrap-continuation-writers
|
||||
[handler options]
|
||||
(fn [req]
|
||||
(let [res (handler req)]
|
||||
(if (:async res)
|
||||
|
|
@ -580,7 +622,8 @@
|
|||
|
||||
;; test channel is used to determine which host to connect to
|
||||
;; and if the connection can support streaming
|
||||
(defn handle-test-channel [req options]
|
||||
(defn handle-test-channel
|
||||
[req options]
|
||||
(if-not (= "8" (get-in req [:query-params "VER"]))
|
||||
(error-response 400 "Version 8 required")
|
||||
;; phase 1
|
||||
|
|
@ -600,8 +643,7 @@
|
|||
;; if client gets two chunks, then there is no buffering
|
||||
;; proxy in the way
|
||||
{:async :http
|
||||
:reactor
|
||||
(fn [respond]
|
||||
:reactor (fn [respond]
|
||||
(write-head respond)
|
||||
(write-raw respond "11111")
|
||||
(schedule #(do (write-raw respond "2")
|
||||
|
|
@ -610,7 +652,8 @@
|
|||
|
||||
;; POST req client -> server is a forward channel
|
||||
;; session might be nil, when this is the first POST by client
|
||||
(defn handle-forward-channel [req session-agent options]
|
||||
(defn handle-forward-channel
|
||||
[req session-agent options]
|
||||
(let [[session-agent is-new-session] (if session-agent
|
||||
[session-agent false]
|
||||
[(create-session-agent req options) true])
|
||||
|
|
@ -628,8 +671,7 @@
|
|||
host-prefix nil]
|
||||
{:status 200
|
||||
:headers (assoc (:headers options) "Content-Type" "application/javascript")
|
||||
:body
|
||||
(size-json-str (json/write-str [[0,["c", session-id, host-prefix, 8]]]))})
|
||||
:body (size-json-str (json/write-str [[0, ["c", session-id, host-prefix, 8]]]))})
|
||||
;; For existing sessions:
|
||||
;; Forward sent data by client to listeners
|
||||
;; reply with
|
||||
|
|
@ -645,14 +687,14 @@
|
|||
:body (size-json-str (json/write-str status))})))))
|
||||
|
||||
;; GET req server->client is a backwardchannel opened by client
|
||||
(defn handle-backward-channel [req session-agent options]
|
||||
(defn handle-backward-channel
|
||||
[req session-agent options]
|
||||
(let [type (get-in req [:query-params "TYPE"])]
|
||||
(cond
|
||||
(#{"xmlhttp" "html"} type)
|
||||
;; @todo check that query RID is "rpc"
|
||||
{:async :http
|
||||
:reactor
|
||||
(fn [respond]
|
||||
:reactor (fn [respond]
|
||||
(write-head respond)
|
||||
(send-off session-agent set-back-channel respond req))}
|
||||
(= type "terminate")
|
||||
|
|
@ -667,7 +709,8 @@
|
|||
|
||||
;; get to /<base>/bind is client->server msg
|
||||
;; post to /<base>/bind is initiate server->client channel
|
||||
(defn handle-bind-channel [req options]
|
||||
(defn handle-bind-channel
|
||||
[req options]
|
||||
(let [SID (get-in req [:query-params "SID"])
|
||||
;; session-agent might be nil, then it will be created by
|
||||
;; handle-forward-channel
|
||||
|
|
@ -689,7 +732,8 @@
|
|||
|
||||
|
||||
;; see default-options for describtion of options
|
||||
(defn wrap-browserchannel [handler & [options]]
|
||||
(defn wrap-browserchannel
|
||||
[handler & [options]]
|
||||
(let [options (merge default-options options)
|
||||
base (str (:base options))]
|
||||
(-> (fn [req]
|
||||
|
|
@ -699,9 +743,12 @@
|
|||
(and (.startsWith uri (str base "/test"))
|
||||
(= method :get))
|
||||
(handle-test-channel req options)
|
||||
|
||||
(.startsWith uri (str base "/bind"))
|
||||
(handle-bind-channel req options)
|
||||
:else (handler req))))
|
||||
|
||||
:else
|
||||
(handler req))))
|
||||
(wrap-continuation-writers options)
|
||||
params/wrap-params
|
||||
)))
|
||||
|
|
|
|||
Reference in a new issue